diff options
Diffstat (limited to 'gcc/ada/ChangeLog')
| -rw-r--r-- | gcc/ada/ChangeLog | 834 |
1 files changed, 834 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f055e344ab..c92ffb9e64b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,837 @@ +2001-12-12 Robert Dewar <dewar@gnat.com> + + * s-stalib.adb: Add more comments on with statements being needed + + * par-ch12.adb: Minor reformatting + + * prj-dect.ads: Fix copyright header + + * s-arit64.adb (Multiply_With_Ovflo_Check): Fix case where both + inputs fit in 32 bits, but the result still overflows. + + * s-fatgen.ads: Minor comment improvement + +2001-12-12 Ed Schonberg <schonber@gnat.com> + + * sem_ch4.adb (Analyze_Selected_Component): If the prefix is of a + formal derived type, look for an inherited component from the full + view of the parent, if any. + +2001-12-12 Robert Dewar <dewar@gnat.com> + + * checks.ads (Apply_Alignment_Check): New procedure. + + * exp_ch13.adb (Expand_N_Freeze_Entity): Generate dynamic check to + ensure that the alignment of objects with address clauses is + appropriate, and raise PE if not. + + * exp_util.ads (Must_Be_Aligned): Removed, replaced by + Exp_Pakd.Known_Aligned_Enough + + * mdllfile.ads: Minor reformatting + + * mlib-fil.ads: Minor reformatting + +2001-12-12 Ed Schonberg <schonber@gnat.com> + + * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Extend previous + fix to any component reference if enclosing record has non-standard + representation. + +2001-12-12 Vincent Celier <celier@gnat.com> + + * g-dirope.ads (Find, Wildcard_Iterator): Moved to child package + Iteration + +2001-12-12 Ed Schonberg <schonber@gnat.com> + + * freeze.ads: Make Freeze_Fixed_Point_Type visible, for use in + sem_attr. + +2001-12-12 Robert Dewar <dewar@gnat.com> + + * impunit.adb: Add entry for GNAT.Directory_Operations.Iteration + +2001-12-12 Emmanuel Briot <briot@gnat.com> + + * g-regexp.adb: Remove all debug code, since it isn't required anymore, + and it adds dependencies to system.io. + +2001-12-12 Pascal Obry <obry@gnat.com> + + * g-dirope.adb (Expand_Path.Var): Correctly detect end of + variable name. + +*** s-stalib.adb 2001/09/03 15:24:33 1.17 +--- s-stalib.adb 2001/10/16 13:14:46 1.18 +*************** +*** 46,59 **** + -- elaboration circularities with Ada.Exceptions if polling is on. + + with System.Soft_Links; +! -- Referenced directly from generated code +! -- Also referenced from exception handling routines. + -- This is needed for programs that don't use exceptions explicitely but + -- direct calls to Ada.Exceptions are generated by gigi (for example, + -- by calling __gnat_raise_constraint_error directly). + + with System.Memory; +! -- Referenced directly from generated code + + package body System.Standard_Library is + +--- 46,62 ---- + -- elaboration circularities with Ada.Exceptions if polling is on. + + with System.Soft_Links; +! -- Referenced directly from generated code using external symbols so it +! -- must always be present in a build, even if no unit has a direct with +! -- of this unit. Also referenced from exception handling routines. + -- This is needed for programs that don't use exceptions explicitely but + -- direct calls to Ada.Exceptions are generated by gigi (for example, + -- by calling __gnat_raise_constraint_error directly). + + with System.Memory; +! -- Referenced directly from generated code using external symbols, so it +! -- must always be present in a build, even if no unit has a direct with +! -- of this unit. + + package body System.Standard_Library is + + +*** par-ch12.adb 2001/10/19 15:22:18 1.48 +--- par-ch12.adb 2001/10/19 15:24:48 1.49 +*************** +*** 452,466 **** + if Def_Node /= Error then + Set_Formal_Type_Definition (Decl_Node, Def_Node); + TF_Semicolon; + else + Decl_Node := Error; + + if Token = Tok_Semicolon then +- -- Avoid further cascaded errors. + Scan; + end if; + end if; +- + + return Decl_Node; + end P_Formal_Type_Declaration; +--- 452,467 ---- + if Def_Node /= Error then + Set_Formal_Type_Definition (Decl_Node, Def_Node); + TF_Semicolon; ++ + else + Decl_Node := Error; + ++ -- If we have semicolon, skip it to avoid cascaded errors ++ + if Token = Tok_Semicolon then + Scan; + end if; + end if; + + return Decl_Node; + end P_Formal_Type_Declaration; + +*** prj-dect.ads 2001/10/20 10:28:13 1.4 +--- prj-dect.ads 2001/10/20 11:43:56 1.5 +*************** +*** 8,14 **** + -- -- + -- $Revision$ + -- -- +! -- Copyright (C) 2000-2001 Free Software Foundation, Inc. -- + -- -- + -- GNAT is free software; you can redistribute it and/or modify it under -- + -- terms of the GNU General Public License as published by the Free Soft- -- +--- 8,14 ---- + -- -- + -- $Revision$ + -- -- +! -- Copyright (C) 2001 Free Software Foundation, Inc. -- + -- -- + -- GNAT is free software; you can redistribute it and/or modify it under -- + -- terms of the GNU General Public License as published by the Free Soft- -- + +*** s-arit64.adb 2001/02/09 15:10:29 1.16 +--- s-arit64.adb 2001/10/20 14:50:39 1.17 +*************** +*** 325,337 **** + T2 := Xhi * Ylo; + end if; + +! else +! if Yhi /= 0 then +! T2 := Xlo * Yhi; +! else +! return X * Y; +! end if; + end if; + + T1 := Xlo * Ylo; + T2 := T2 + Hi (T1); +--- 325,339 ---- + T2 := Xhi * Ylo; + end if; + +! elsif Yhi /= 0 then +! T2 := Xlo * Yhi; +! +! else -- Yhi = Xhi = 0 +! T2 := 0; + end if; ++ ++ -- Here we have T2 set to the contribution to the upper half ++ -- of the result from the upper halves of the input values. + + T1 := Xlo * Ylo; + T2 := T2 + Hi (T1); + +*** s-fatgen.ads 2001/07/20 00:59:34 1.9 +--- s-fatgen.ads 2001/10/20 18:37:39 1.10 +*************** +*** 89,97 **** + + function Unbiased_Rounding (X : T) return T; + +! function Valid (X : access T) return Boolean; +! -- The argument must be passed by reference here, as T may be +! -- an abnormal value that can be passed in a floating point register. + + private + pragma Inline (Machine); +--- 89,100 ---- + + function Unbiased_Rounding (X : T) return T; + +! function Valid (X : access T) return Boolean; +! -- This function checks if the object of type T referenced by X +! -- is valid, and returns True/False accordingly. The parameter is +! -- passed by reference (access) here, as the object of type T may +! -- be an abnormal value that cannot be passed in a floating-point +! -- register, and the whole point of 'Valid is to prevent exceptions. + + private + pragma Inline (Machine); + +*** sem_ch4.adb 2001/09/24 22:32:31 1.511 +--- sem_ch4.adb 2001/10/21 17:41:52 1.512 +*************** +*** 2691,2696 **** +--- 2691,2708 ---- + + Check_Misspelled_Selector (Entity_List, Sel); + ++ elsif Is_Generic_Type (Prefix_Type) ++ and then Ekind (Prefix_Type) = E_Record_Type_With_Private ++ and then Is_Record_Type (Etype (Prefix_Type)) ++ then ++ -- If this is a derived formal type, the parent may have a ++ -- different visibility at this point. Try for an inherited ++ -- component before reporting an error. ++ ++ Set_Etype (Prefix (N), Etype (Prefix_Type)); ++ Analyze_Selected_Component (N); ++ return; ++ + else + if Ekind (Prefix_Type) = E_Record_Subtype then + + +*** checks.ads 2001/07/16 01:26:04 1.55 +--- checks.ads 2001/10/28 15:13:02 1.56 +*************** +*** 83,88 **** +--- 83,95 ---- + -- the object denoted by the access parameter is not deeper than the + -- level of the type Typ. Program_Error is raised if the check fails. + ++ procedure Apply_Alignment_Check (E : Entity_Id; N : Node_Id); ++ -- E is the entity for an object. If there is an address clause for ++ -- this entity, and checks are enabled, then this procedure generates ++ -- a check that the specified address has an alignment consistent with ++ -- the alignment of the object, raising PE if this is not the case. The ++ -- resulting check (if one is generated) is inserted before node N. ++ + procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id); + -- N is the node for an object declaration that declares an object of + -- array type Typ. This routine generates, if necessary, a check that + +*** exp_ch13.adb 2001/07/16 21:21:29 1.76 +--- exp_ch13.adb 2001/10/28 15:13:25 1.77 +*************** +*** 27,32 **** +--- 27,33 ---- + ------------------------------------------------------------------------------ + + with Atree; use Atree; ++ with Checks; use Checks; + with Einfo; use Einfo; + with Exp_Ch3; use Exp_Ch3; + with Exp_Ch6; use Exp_Ch6; +*************** +*** 236,245 **** + Decl : Node_Id; + + begin +! if not Is_Type (E) and then not Is_Subprogram (E) then + return; + end if; + + E_Scope := Scope (E); + + -- If we are freezing entities defined in protected types, they +--- 237,256 ---- + Decl : Node_Id; + + begin +! -- For object, with address clause, check alignment is OK +! +! if Is_Object (E) then +! Apply_Alignment_Check (E, N); +! +! -- Only other items requiring any front end action are +! -- types and subprograms. +! +! elsif not Is_Type (E) and then not Is_Subprogram (E) then + return; + end if; + ++ -- Here E is a type or a subprogram ++ + E_Scope := Scope (E); + + -- If we are freezing entities defined in protected types, they +*************** +*** 304,314 **** + + elsif Is_Subprogram (E) then + Freeze_Subprogram (N); +- +- -- No other entities require any front end freeze actions +- +- else +- null; + end if; + + -- Analyze actions generated by freezing. The init_proc contains +--- 315,320 ---- + +*** exp_util.ads 2001/07/23 10:05:17 1.112 +--- exp_util.ads 2001/10/28 15:14:04 1.113 +*************** +*** 372,386 **** + -- routine is to help avoid generating troublesome temporaries that + -- intefere with the stack checking mechanism. + +- function Must_Be_Aligned (Obj : Node_Id) return Boolean; +- -- Given an object reference, determines whether or not the object +- -- is required to be aligned according to its type'alignment value. +- -- Normally, objects are required to be aligned, and the result will +- -- be True. The situation in which this is not the case is if the +- -- object reference involves a component of a packed array, where +- -- the type of the component is not required to have strict alignment. +- -- In this case, false will be returned. +- + procedure Remove_Side_Effects + (Exp : Node_Id; + Name_Req : Boolean := False; +--- 372,377 ---- + +*** mdllfile.ads 2001/10/29 02:06:24 1.2 +--- mdllfile.ads 2001/10/29 02:50:12 1.3 +*************** +*** 26,52 **** + -- -- + ------------------------------------------------------------------------------ + +! -- Simple services used by GNATDLL to deal with Filename extension. + + package MDLL.Files is + + No_Ext : constant String := ""; + +! function Get_Ext (Filename : in String) +! return String; +! -- return filename's extension. +! +! function Is_Ali (Filename : in String) +! return Boolean; +! -- test if Filename is an Ada library file (.ali). +! +! function Is_Obj (Filename : in String) +! return Boolean; +! -- test if Filename is an object file (.o or .obj). +! +! function Ext_To (Filename : in String; +! New_Ext : in String := No_Ext) +! return String; +! -- return Filename with the extension change to New_Ext. + + end MDLL.Files; +--- 26,51 ---- + -- -- + ------------------------------------------------------------------------------ + +! -- Simple services used by GNATDLL to deal with Filename extension + + package MDLL.Files is + + No_Ext : constant String := ""; ++ -- Used to mark the absence of an extension + +! function Get_Ext (Filename : String) return String; +! -- Return extension of Filename +! +! function Is_Ali (Filename : String) return Boolean; +! -- Test if Filename is an Ada library file (.ali). +! +! function Is_Obj (Filename : String) return Boolean; +! -- Test if Filename is an object file (.o or .obj) +! +! function Ext_To +! (Filename : String; +! New_Ext : String := No_Ext) +! return String; +! -- Return Filename with the extension change to New_Ext + + end MDLL.Files; + +*** mlib-fil.ads 2001/10/29 02:06:26 1.3 +--- mlib-fil.ads 2001/10/29 02:51:28 1.4 +*************** +*** 36,51 **** + return String; + -- Return Filename with the extension change to New_Ext. + +! function Get_Ext (Filename : in String) return String; + -- Return extension of filename. + + function Is_Archive (Filename : String) return Boolean; + -- Test if filename is an archive + +! function Is_C (Filename : in String) return Boolean; + -- Test if Filename is a C file + +! function Is_Obj (Filename : in String) return Boolean; + -- Test if Filename is an object file + + end MLib.Fil; +--- 36,51 ---- + return String; + -- Return Filename with the extension change to New_Ext. + +! function Get_Ext (Filename : String) return String; + -- Return extension of filename. + + function Is_Archive (Filename : String) return Boolean; + -- Test if filename is an archive + +! function Is_C (Filename : String) return Boolean; + -- Test if Filename is a C file + +! function Is_Obj (Filename : String) return Boolean; + -- Test if Filename is an object file + + end MLib.Fil; + +*** exp_ch8.adb 2001/10/03 02:17:32 1.30 +--- exp_ch8.adb 2001/10/29 17:32:24 1.31 +*************** +*** 59,65 **** + -- of the renamed object. The cases in which this is not true are when + -- this address is not computable, since it involves extraction of a + -- packed array element, or of a record component to which a component +! -- clause applies (that can specify an arbitrary bit boundary). + + -- In these two cases, we pre-evaluate the renaming expression, by + -- extracting and freezing the values of any subscripts, and then we +--- 59,66 ---- + -- of the renamed object. The cases in which this is not true are when + -- this address is not computable, since it involves extraction of a + -- packed array element, or of a record component to which a component +! -- clause applies (that can specify an arbitrary bit boundary), or where +! -- the enclosing record itself has a non-standard representation. + + -- In these two cases, we pre-evaluate the renaming expression, by + -- extracting and freezing the values of any subscripts, and then we +*************** +*** 211,228 **** + end if; + + elsif Nkind (Nam) = N_Selected_Component then +! if Present (Component_Clause (Entity (Selector_Name (Nam)))) then +! return True; + +! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant +! and then Is_Record_Type (Etype (Prefix (Nam))) +! and then not Is_Concurrent_Record_Type (Etype (Prefix (Nam))) +! then +! return True; + +! else +! return Evaluation_Required (Prefix (Nam)); +! end if; + + else + return False; +--- 212,236 ---- + end if; + + elsif Nkind (Nam) = N_Selected_Component then +! declare +! Rec_Type : Entity_Id := Etype (Prefix (Nam)); + +! begin +! if Present (Component_Clause (Entity (Selector_Name (Nam)))) +! or else Has_Non_Standard_Rep (Rec_Type) +! then +! return True; +! +! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant +! and then Is_Record_Type (Rec_Type) +! and then not Is_Concurrent_Record_Type (Rec_Type) +! then +! return True; + +! else +! return Evaluation_Required (Prefix (Nam)); +! end if; +! end; + + else + return False; + +*** g-dirope.ads 2001/08/27 09:48:38 1.12 +--- g-dirope.ads 2001/10/29 19:18:13 1.13 +*************** +*** 38,43 **** +--- 38,47 ---- + -- can be treated as a file, using open and close routines, and a scanning + -- routine is provided for iterating through the entries in a directory. + ++ -- See also child package GNAT.Directory_Operations.Iteration ++ ++ with Ada.Strings.Maps; ++ + package GNAT.Directory_Operations is + + subtype Dir_Name_Str is String; +*************** +*** 187,248 **** + -- returned in target-OS form. Raises Directory_Error if Dir has not + -- be opened (Dir = Null_Dir). + +- generic +- with procedure Action +- (Item : String; +- Index : Positive; +- Quit : in out Boolean); +- procedure Wildcard_Iterator (Path : Path_Name); +- -- Calls Action for each path matching Path. Path can include wildcards '*' +- -- and '?' and [...]. The rules are: +- -- +- -- * can be replaced by any sequence of characters +- -- ? can be replaced by a single character +- -- [a-z] match one character in the range 'a' through 'z' +- -- [abc] match either character 'a', 'b' or 'c' +- -- +- -- Item is the filename that has been matched. Index is set to one for the +- -- first call and is incremented by one at each call. The iterator's +- -- termination can be controlled by setting Quit to True. It is by default +- -- set to False. +- -- +- -- For example, if we have the following directory structure: +- -- /boo/ +- -- foo.ads +- -- /sed/ +- -- foo.ads +- -- file/ +- -- foo.ads +- -- /sid/ +- -- foo.ads +- -- file/ +- -- foo.ads +- -- /life/ +- -- +- -- A call with expression "/s*/file/*" will call Action for the following +- -- items: +- -- /sed/file/foo.ads +- -- /sid/file/foo.ads +- +- generic +- with procedure Action +- (Item : String; +- Index : Positive; +- Quit : in out Boolean); +- procedure Find +- (Root_Directory : Dir_Name_Str; +- File_Pattern : String); +- -- Recursively searches the directory structure rooted at Root_Directory. +- -- This provides functionality similar to the UNIX 'find' command. +- -- Action will be called for every item matching the regular expression +- -- File_Pattern (see GNAT.Regexp). Item is the full pathname to the file +- -- starting with Root_Directory that has been matched. Index is set to one +- -- for the first call and is incremented by one at each call. The iterator +- -- will pass in the value False on each call to Action. The iterator will +- -- terminate after passing the last matched path to Action or after +- -- returning from a call to Action which sets Quit to True. +- -- Raises GNAT.Regexp.Error_In_Regexp if File_Pattern is ill formed. +- + function Read_Is_Thread_Safe return Boolean; + -- Indicates if procedure Read is thread safe. On systems where the + -- target system supports this functionality, Read is thread safe, +--- 191,196 ---- +*************** +*** 259,263 **** +--- 207,215 ---- + Null_Dir : constant Dir_Type := null; + + pragma Import (C, Dir_Separator, "__gnat_dir_separator"); ++ ++ Dir_Seps : constant Ada.Strings.Maps.Character_Set := ++ Ada.Strings.Maps.To_Set ("/\"); ++ -- UNIX and DOS style directory separators. + + end GNAT.Directory_Operations; + +*** freeze.ads 2001/10/29 02:06:04 1.15 +--- freeze.ads 2001/10/30 01:36:24 1.16 +*************** +*** 205,210 **** +--- 205,215 ---- + -- so need to be similarly treated. Freeze_Expression takes care of + -- determining the proper insertion point for generated freeze actions. + ++ procedure Freeze_Fixed_Point_Type (Typ : Entity_Id); ++ -- Freeze fixed point type. For fixed-point types, we have to defer ++ -- setting the size and bounds till the freeze point, since they are ++ -- potentially affected by the presence of size and small clauses. ++ + procedure Freeze_Itype (T : Entity_Id; N : Node_Id); + -- This routine is called when an Itype is created and must be frozen + -- immediately at the point of creation (for the sake of the expansion + +*** impunit.adb 2001/09/26 07:14:11 1.14 +--- impunit.adb 2001/10/30 04:33:45 1.15 +*************** +*** 195,200 **** +--- 195,201 ---- + "g-curexc", -- GNAT.Current_Exception + "g-debpoo", -- GNAT.Debug_Pools + "g-debuti", -- GNAT.Debug_Utilities ++ "g-diopit", -- GNAT.Directory_Operations.Iteration + "g-dirope", -- GNAT.Directory_Operations + "g-dyntab", -- GNAT.Dynamic_Tables + "g-exctra", -- GNAT.Exception_Traces + +*** g-regexp.adb 2001/10/21 11:04:16 1.28 +--- g-regexp.adb 2001/10/30 15:25:04 1.29 +*************** +*** 32,38 **** + -- -- + ------------------------------------------------------------------------------ + +- with System.IO; + with Unchecked_Deallocation; + with Ada.Exceptions; + with GNAT.Case_Util; +--- 32,37 ---- +*************** +*** 73,82 **** + end record; + -- Deterministic finite-state machine + +- Debug : constant Boolean := False; +- -- When True, the primary and secondary tables will be printed. +- -- Gnat does not generate any code if this variable is False; +- + ----------------------- + -- Local Subprograms -- + ----------------------- +--- 72,77 ---- +*************** +*** 188,199 **** + pragma No_Return (Raise_Exception); + -- Raise an exception, indicating an error at character Index in S. + +- procedure Print_Table +- (Table : Regexp_Array; +- Num_States : State_Index; +- Is_Primary : Boolean := True); +- -- Print a table for debugging purposes +- + -------------------- + -- Create_Mapping -- + -------------------- +--- 183,188 ---- +*************** +*** 1225,1309 **** + end loop; + end loop; + +- if Debug then +- System.IO.New_Line; +- System.IO.Put_Line ("Secondary table : "); +- Print_Table (R.States, Nb_State, False); +- end if; +- + return (Ada.Finalization.Controlled with R => R); + end; + end Create_Secondary_Table; + +- ----------------- +- -- Print_Table -- +- ----------------- +- +- procedure Print_Table +- (Table : Regexp_Array; +- Num_States : State_Index; +- Is_Primary : Boolean := True) +- is +- function Reverse_Mapping (N : Column_Index) return Character; +- -- Return the character corresponding to a column in the mapping +- +- --------------------- +- -- Reverse_Mapping -- +- --------------------- +- +- function Reverse_Mapping (N : Column_Index) return Character is +- begin +- for Column in Map'Range loop +- if Map (Column) = N then +- return Column; +- end if; +- end loop; +- +- return ' '; +- end Reverse_Mapping; +- +- -- Start of processing for Print_Table +- +- begin +- -- Print the header line +- +- System.IO.Put (" [*] "); +- +- for Column in 1 .. Alphabet_Size loop +- System.IO.Put +- (String'(1 .. 1 => Reverse_Mapping (Column)) & " "); +- end loop; +- +- if Is_Primary then +- System.IO.Put ("closure...."); +- end if; +- +- System.IO.New_Line; +- +- -- Print every line +- +- for State in 1 .. Num_States loop +- System.IO.Put (State'Img); +- +- for K in 1 .. 3 - State'Img'Length loop +- System.IO.Put (" "); +- end loop; +- +- for K in 0 .. Alphabet_Size loop +- System.IO.Put (Table (State, K)'Img & " "); +- end loop; +- +- for K in Alphabet_Size + 1 .. Table'Last (2) loop +- if Table (State, K) /= 0 then +- System.IO.Put (Table (State, K)'Img & ","); +- end if; +- end loop; +- +- System.IO.New_Line; +- end loop; +- +- end Print_Table; +- + --------------------- + -- Raise_Exception -- + --------------------- +--- 1214,1223 ---- +*************** +*** 1345,1356 **** + (Table, Num_States, Start_State, End_State); + end if; + +- if Debug then +- Print_Table (Table.all, Num_States); +- System.IO.Put_Line ("Start_State : " & Start_State'Img); +- System.IO.Put_Line ("End_State : " & End_State'Img); +- end if; +- + -- Creates the secondary table + + R := Create_Secondary_Table +--- 1259,1264 ---- +*************** +*** 1451,1467 **** + New_Table := new Regexp_Array (Table'First (1) .. New_Lines, + Table'First (2) .. New_Columns); + New_Table.all := (others => (others => 0)); +- +- if Debug then +- System.IO.Put_Line ("Reallocating table: Lines from " +- & State_Index'Image (Table'Last (1)) +- & " to " +- & State_Index'Image (New_Lines)); +- System.IO.Put_Line (" and columns from " +- & Column_Index'Image (Table'Last (2)) +- & " to " +- & Column_Index'Image (New_Columns)); +- end if; + + for J in Table'Range (1) loop + for K in Table'Range (2) loop +--- 1359,1364 ---- + +*** g-dirope.adb 2001/10/31 21:36:04 1.20 +--- g-dirope.adb 2001/11/01 16:39:33 1.21 +*************** +*** 371,387 **** + E := E + 1; + + Var_Name : loop +! exit Var_Name when E = Path'Last; + + if Characters.Handling.Is_Letter (Path (E)) + or else Characters.Handling.Is_Digit (Path (E)) + then + E := E + 1; + else +- E := E - 1; + exit Var_Name; + end if; + end loop Var_Name; + + declare + Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E)); +--- 371,388 ---- + E := E + 1; + + Var_Name : loop +! exit Var_Name when E > Path'Last; + + if Characters.Handling.Is_Letter (Path (E)) + or else Characters.Handling.Is_Digit (Path (E)) + then + E := E + 1; + else + exit Var_Name; + end if; + end loop Var_Name; ++ ++ E := E - 1; + + declare + Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E)); 2001-12-11 Ed Schonberg <schonber@gnat.com> * sem_ch10.adb (Install_Withed_Unit): If the unit is a generic instance |