home *** CD-ROM | disk | FTP | other *** search
- ------------------------------------------------------------------------------
- -- --
- -- GNAT COMPILER COMPONENTS --
- -- --
- -- S Y S T E M . V A L _ E N U M --
- -- --
- -- B o d y --
- -- --
- -- $Revision: 1.6 $ --
- -- --
- -- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved --
- -- --
- -- The GNAT library is free software; you can redistribute it and/or modify --
- -- it under terms of the GNU Library General Public License as published by --
- -- the Free Software Foundation; either version 2, or (at your option) any --
- -- later version. The GNAT library is distributed in the hope that it will --
- -- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty --
- -- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
- -- Library General Public License for more details. You should have --
- -- received a copy of the GNU Library General Public License along with --
- -- the GNAT library; see the file COPYING.LIB. If not, write to the Free --
- -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
- -- --
- ------------------------------------------------------------------------------
-
- with System.Val_Util; use System.Val_Util;
- with Unchecked_Conversion;
-
- package body System.Val_Enum is
-
- -----------------------
- -- Value_Enumeration --
- -----------------------
-
- function Value_Enumeration
- (A : Address;
- Last_Pos : Natural;
- Str : String)
- return Natural
- is
- type String_Access is access String;
- type Enum_Table is array (Natural) of String_Access;
- type Enum_Table_Ptr is access Enum_Table;
- function A_To_T is new Unchecked_Conversion (Address, Enum_Table_Ptr);
-
- F : Natural;
- L : Natural;
- S : String (Str'Range) := Str;
- T : constant Enum_Table_Ptr := A_To_T (A);
-
- begin
- Normalize_String (S, F, L);
-
- for J in 0 .. Last_Pos loop
- if T (J).all = S (F .. L) then
- return J;
- end if;
- end loop;
-
- raise Constraint_Error;
-
- end Value_Enumeration;
-
- end System.Val_Enum;
-