diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/a-crbtgo.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/gnatlink.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 209 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/osint.ads | 60 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_case.adb | 9 |
10 files changed, 220 insertions, 174 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 16b8670bca6..7bbbc065809 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2009-11-30 Robert Dewar <dewar@adacore.com> + + * bcheck.adb, gnatlink.adb, make.adb, makeutl.adb, osint.adb, + osint.ads, prj-ext.adb, sem_case.adb: Minor reformatting + * g-alleve.adb: Minor code reorganization (use conditional expressions) + +2009-11-30 Matthew Heaney <heaney@adacore.com> + + * a-crbtgo.adb (Delete_Fixup): Changed always-true predicates to + assertions. + +2009-11-30 Thomas Quinot <quinot@adacore.com> + + * a-tasatt.adb, s-crtl.ads, s-taprop-dummy.adb (System.CRTL.malloc32, + System.CRTL.realloc32): Remove VMS-specific routines. + (Ada.Task_Attributes.Reference): Remove unreachable code. + (System.Task_Primitives.Operations.Initialize, dummy version): + Use plain Program_Error rather than call to + System.Error_Reporting.Shutdown. + 2009-11-30 Thomas Quinot <quinot@adacore.com> * s-oscons-tmplt.c, xoscons.adb: Add new constants in preparation for diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb index 9b30226b066..cd14b90491d 100644 --- a/gcc/ada/a-crbtgo.adb +++ b/gcc/ada/a-crbtgo.adb @@ -171,10 +171,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is if Right (W) = null or else Color (Right (W)) = Black then - if Left (W) /= null then - Set_Color (Left (W), Black); - end if; - + pragma Assert (Left (W) /= null); + Set_Color (Left (W), Black); Set_Color (W, Red); Right_Rotate (Tree, W); W := Right (Parent (X)); @@ -208,10 +206,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is else if Left (W) = null or else Color (Left (W)) = Black then - if Right (W) /= null then - Set_Color (Right (W), Black); - end if; - + pragma Assert (Right (W) /= null); + Set_Color (Right (W), Black); Set_Color (W, Red); Left_Rotate (Tree, W); W := Left (Parent (X)); diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 18739e878ed..084ce199dda 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -191,6 +191,7 @@ package body Bcheck is else ALI_Path_Id := Osint.Full_Lib_File_Name (ALIs.Table (A).Afile); + if Osint.Is_Readonly_Library (ALI_Path_Id) then if Tolerate_Consistency_Errors then Error_Msg ("?{ should be recompiled"); diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 5347269be00..0e4618f3d64 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -2148,11 +2148,10 @@ begin if Linker_Path = Gcc_Path and then VM_Target = No_VM then - -- For systems where the default is to link statically - -- with libgcc, if gcc is not called with - -- -shared-libgcc, call it with -static-libgcc, as - -- there are some platforms where one of these two - -- switches is compulsory to link. + -- For systems where the default is to link statically with + -- libgcc, if gcc is not called with -shared-libgcc, call it + -- with -static-libgcc, as there are some platforms where one + -- of these two switches is compulsory to link. if Shared_Libgcc_Default = 'T' and then not Shared_Libgcc_Seen diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 12e6386d045..89a4ad54f05 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2453,14 +2453,12 @@ package body Make is procedure Await_Compile (Data : out Compilation_Data; OK : out Boolean); - -- Awaits that an outstanding compilation process terminates. When - -- it does set Data to the information registered for the corresponding - -- call to Add_Process. - -- Note that this time stamp can be used to check whether the - -- compilation did generate an object file. OK is set to True if the - -- compilation succeeded. - -- Data could be No_Compilation_Data if there was no compilation to wait - -- for. + -- Awaits that an outstanding compilation process terminates. When it + -- does set Data to the information registered for the corresponding + -- call to Add_Process. Note that this time stamp can be used to check + -- whether the compilation did generate an object file. OK is set to + -- True if the compilation succeeded. Data could be No_Compilation_Data + -- if there was no compilation to wait for. function Bad_Compilation_Count return Natural; -- Returns the number of compilation failures @@ -2474,9 +2472,9 @@ package body Make is Source_Index : Int; Pid : out Process_Id; Process_Created : out Boolean); - -- Collect arguments from project file (if any) and compile. - -- If no compilation was attempted, Processed_Created is set to False, - -- and the value of Pid is unknown. + -- Collect arguments from project file (if any) and compile. If no + -- compilation was attempted, Processed_Created is set to False, and the + -- value of Pid is unknown. function Compile (Project : Project_Id; @@ -2579,18 +2577,18 @@ package body Make is ------------------- procedure Await_Compile - (Data : out Compilation_Data; - OK : out Boolean) + (Data : out Compilation_Data; + OK : out Boolean) is - Pid : Process_Id; - Project : Project_Id; + Pid : Process_Id; + Project : Project_Id; Comp_Data : Project_Compilation_Access; begin pragma Assert (Outstanding_Compiles > 0); - Data := No_Compilation_Data; - OK := False; + Data := No_Compilation_Data; + OK := False; -- The loop here is a work-around for a problem on VMS; in some -- circumstances (shared library and several executables, for @@ -2614,13 +2612,14 @@ package body Make is -- file name for reuse by a subsequent compilation. if Running_Compile (J).Mapping_File /= No_Mapping_File then - Comp_Data := Project_Compilation_Htable.Get - (Project_Compilation, Project); + Comp_Data := + Project_Compilation_Htable.Get + (Project_Compilation, Project); Comp_Data.Last_Free_Indices := Comp_Data.Last_Free_Indices + 1; Comp_Data.Free_Mapping_File_Indices (Comp_Data.Last_Free_Indices) := - Running_Compile (J).Mapping_File; + Running_Compile (J).Mapping_File; end if; -- To actually remove this Pid and related info from @@ -2629,7 +2628,6 @@ package body Make is if J = Outstanding_Compiles then null; - else Running_Compile (J) := Running_Compile (Outstanding_Compiles); @@ -2643,6 +2641,8 @@ package body Make is -- This child process was not one of our compilation processes; -- just ignore it for now. + -- Why is this commented out code sitting here??? + -- raise Program_Error; end loop; end Await_Compile; @@ -3001,6 +3001,7 @@ package body Make is Uname : Unit_Name_Type; Unit_Name : Name_Id; Uid : Prj.Unit_Index; + begin while Good_ALI_Present loop ALI := Get_Next_Good_ALI; @@ -3015,24 +3016,23 @@ package body Make is Main_Unit := ALIs.Table (ALI).Main_Program /= None; end if; - -- The following adds the standard library (s-stalib) to the - -- list of files to be handled by gnatmake: this file and any - -- files it depends on are always included in every bind, - -- even if they are not in the explicit dependency list. - -- Of course, it is not added if Suppress_Standard_Library - -- is True. + -- The following adds the standard library (s-stalib) to the list + -- of files to be handled by gnatmake: this file and any files it + -- depends on are always included in every bind, even if they are + -- not in the explicit dependency list. Of course, it is not added + -- if Suppress_Standard_Library is True. - -- However, to avoid annoying output about s-stalib.ali being - -- read only, when "-v" is used, we add the standard library - -- only when "-a" is used. + -- However, to avoid annoying output about s-stalib.ali being read + -- only, when "-v" is used, we add the standard library only when + -- "-a" is used. if Need_To_Check_Standard_Library then Check_Standard_Library; end if; - -- Now insert in the Q the unmarked source files (i.e. those - -- which have never been inserted in the Q and hence never - -- considered). Only do that if Unique_Compile is False. + -- Now insert in the Q the unmarked source files (i.e. those which + -- have never been inserted in the Q and hence never considered). + -- Only do that if Unique_Compile is False. if not Unique_Compile then for J in @@ -3044,9 +3044,8 @@ package body Make is Sfile := Withs.Table (K).Sfile; Uname := Withs.Table (K).Uname; - -- If project files are used, find the proper source - -- to compile, in case Sfile is the spec, but there - -- is a body. + -- If project files are used, find the proper source to + -- compile in case Sfile is the spec but there is a body. if Main_Project /= No_Project then Get_Name_String (Uname); @@ -3163,8 +3162,9 @@ package body Make is -------------------------------- function Must_Exit_Because_Of_Error return Boolean is - Data : Compilation_Data; - Success : Boolean; + Data : Compilation_Data; + Success : Boolean; + begin if Bad_Compilation_Count > 0 and then not Keep_Going then while Outstanding_Compiles > 0 loop @@ -3212,29 +3212,29 @@ package body Make is function Start_Compile_If_Possible (Args : Argument_List) return Boolean is - In_Lib_Dir : Boolean; - Need_To_Compile : Boolean; - Pid : Process_Id; - Process_Created : Boolean; + In_Lib_Dir : Boolean; + Need_To_Compile : Boolean; + Pid : Process_Id; + Process_Created : Boolean; Source_File : File_Name_Type; Full_Source_File : File_Name_Type; Source_File_Attr : aliased File_Attributes; -- The full name of the source file and its attributes (size, ...) - Source_Unit : Unit_Name_Type; - Source_Index : Int; + Source_Unit : Unit_Name_Type; + Source_Index : Int; -- Index of the current unit in the current source file - Lib_File : File_Name_Type; - Full_Lib_File : File_Name_Type; - Lib_File_Attr : aliased File_Attributes; - Read_Only : Boolean := False; - ALI : ALI_Id; + Lib_File : File_Name_Type; + Full_Lib_File : File_Name_Type; + Lib_File_Attr : aliased File_Attributes; + Read_Only : Boolean := False; + ALI : ALI_Id; -- The ALI file and its attributes (size, stamp, ...) - Obj_File : File_Name_Type; - Obj_Stamp : Time_Stamp_Type; + Obj_File : File_Name_Type; + Obj_Stamp : Time_Stamp_Type; -- The object file begin @@ -3252,8 +3252,7 @@ package body Make is Lib_File => Full_Lib_File, Attr => Lib_File_Attr); - -- If this source has already been compiled, the executable is - -- obsolete. + -- If source has already been compiled, executable is obsolete if Is_In_Obsoleted (Source_File) then Executable_Obsolete := True; @@ -3359,7 +3358,8 @@ package body Make is end if; if not Need_To_Compile then - -- The ALI file is up-to-date. Record its Id + + -- The ALI file is up-to-date; record its Id Record_Good_ALI (ALI); @@ -3368,15 +3368,15 @@ package body Make is if First_Compiled_File = No_File and then (Most_Recent_Obj_File = No_File - or else Obj_Stamp > Most_Recent_Obj_Stamp) + or else Obj_Stamp > Most_Recent_Obj_Stamp) then Most_Recent_Obj_File := Obj_File; Most_Recent_Obj_Stamp := Obj_Stamp; end if; else - -- Check that switch -x has been used if a source - -- outside of project files need to be compiled. + -- Check that switch -x has been used if a source outside + -- of project files need to be compiled. if Main_Project /= No_Project and then Arguments_Project = No_Project @@ -3396,6 +3396,7 @@ package body Make is Most_Recent_Obj_File := No_File; if Do_Not_Execute then + -- Exit the main loop return True; @@ -3408,11 +3409,13 @@ package body Make is if In_Place_Mode then if Full_Lib_File = No_File then + -- If the library file was not found, then save -- the library file near the source file. - Lib_File := Osint.Lib_File_Name - (Full_Source_File, Source_Index); + Lib_File := + Osint.Lib_File_Name + (Full_Source_File, Source_Index); Full_Lib_File := Lib_File; else @@ -3441,6 +3444,7 @@ package body Make is -- being the same to find the resulting ALI file. if not In_Place_Mode then + -- Compute the expected location of the ALI file. This -- can be from several places: -- -i => in place mode. In such a case, @@ -3456,6 +3460,7 @@ package body Make is Add_Str_To_Name_Buffer (Object_Directory_Path.all); Add_Str_To_Name_Buffer (Get_Name_String (Lib_File)); Full_Lib_File := Name_Find; + else if Project_Of_Current_Object_Directory /= No_Project @@ -3466,6 +3471,7 @@ package body Make is Add_Str_To_Name_Buffer (Get_Name_String (Lib_File)); Full_Lib_File := Name_Find; + else Full_Lib_File := Lib_File; end if; @@ -3475,21 +3481,20 @@ package body Make is Lib_File_Attr := Unknown_Attributes; - -- Make sure we could successfully start - -- the Compilation. + -- Make sure we could successfully start the Compilation if Process_Created then if Pid = Invalid_Pid then Record_Failure (Full_Source_File, Source_Unit); else Add_Process - (Pid => Pid, - Sfile => Full_Source_File, - Afile => Lib_File, - Uname => Source_Unit, - Mfile => Mfile, - Full_Lib_File => Full_Lib_File, - Lib_File_Attr => Lib_File_Attr); + (Pid => Pid, + Sfile => Full_Source_File, + Afile => Lib_File, + Uname => Source_Unit, + Mfile => Mfile, + Full_Lib_File => Full_Lib_File, + Lib_File_Attr => Lib_File_Attr); end if; end if; end if; @@ -3504,16 +3509,16 @@ package body Make is ----------------------------- procedure Wait_For_Available_Slot is - Compilation_OK : Boolean; - Text : Text_Buffer_Ptr; - ALI : ALI_Id; - Data : Compilation_Data; + Compilation_OK : Boolean; + Text : Text_Buffer_Ptr; + ALI : ALI_Id; + Data : Compilation_Data; begin if Outstanding_Compiles = Max_Process or else (Empty_Q - and then not Good_ALI_Present - and then Outstanding_Compiles > 0) + and then not Good_ALI_Present + and then Outstanding_Compiles > 0) then Await_Compile (Data, Compilation_OK); @@ -3536,26 +3541,28 @@ package body Make is Check_Object_Consistency := Check_Object_Consistency - and Compilation_OK - and (Output_Is_Object or Do_Bind_Step); + and Compilation_OK + and (Output_Is_Object or Do_Bind_Step); - Text := Read_Library_Info_From_Full - (Data.Full_Lib_File, Data.Lib_File_Attr'Access); + Text := + Read_Library_Info_From_Full + (Data.Full_Lib_File, Data.Lib_File_Attr'Access); -- Restore Check_Object_Consistency to its initial value Check_Object_Consistency := Saved_Object_Consistency; end; - -- If an ALI file was generated by this compilation, scan - -- the ALI file and record it. + -- If an ALI file was generated by this compilation, scan the + -- ALI file and record it. -- If the scan fails, a previous ali file is inconsistent with -- the unit just compiled. if Text /= null then - ALI := Scan_ALI - (Data.Lib_File, Text, Ignore_ED => False, Err => True); + ALI := + Scan_ALI + (Data.Lib_File, Text, Ignore_ED => False, Err => True); if ALI = No_ALI_Id then @@ -3616,11 +3623,11 @@ package body Make is end if; -- The following two flags affect the behavior of ALI.Set_Source_Table. - -- We set Check_Source_Files to True to ensure that source file - -- time stamps are checked, and we set All_Sources to False to - -- avoid checking the presence of the source files listed in the - -- source dependency section of an ali file (which would be a mistake - -- since the ali file may be obsolete). + -- We set Check_Source_Files to True to ensure that source file time + -- stamps are checked, and we set All_Sources to False to avoid checking + -- the presence of the source files listed in the source dependency + -- section of an ali file (which would be a mistake since the ali file + -- may be obsolete). Check_Source_Files := True; All_Sources := False; @@ -4357,8 +4364,7 @@ package body Make is -- Otherwise, if there is a spec, put it in the mapping elsif Unit.File_Names (Spec) /= No_Source - and then Unit.File_Names (Spec).Project /= - No_Project + and then Unit.File_Names (Spec).Project /= No_Project then Get_Name_String (Unit.Name); Add_Str_To_Name_Buffer ("%s"); @@ -4576,9 +4582,9 @@ package body Make is end if; -- If no mains have been specified on the command line, and we are - -- using a project file, we either find the main(s) in attribute - -- Main of the main project, or we put all the sources of the project - -- file as mains. + -- using a project file, we either find the main(s) in attribute Main + -- of the main project, or we put all the sources of the project file + -- as mains. else if Main_Index /= 0 then @@ -4626,19 +4632,18 @@ package body Make is end if; else - -- The attribute Main is not an empty list. - -- Put all the main subprograms in the list as if they were - -- specified on the command line. However, if attribute - -- Languages includes a language other than Ada, only - -- include the Ada mains; if there is no Ada main, compile - -- all the sources of the project. + -- The attribute Main is not an empty list. Put all the main + -- subprograms in the list as if they were specified on the + -- command line. However, if attribute Languages includes a + -- language other than Ada, only include the Ada mains; if + -- there is no Ada main, compile all sources of the project. declare Languages : constant Variable_Value := Prj.Util.Value_Of - (Name_Languages, - Main_Project.Decl.Attributes, - Project_Tree); + (Name_Languages, + Main_Project.Decl.Attributes, + Project_Tree); Current : String_List_Id; Element : String_Element; @@ -4652,7 +4657,6 @@ package body Make is if not Languages.Default then Current := Languages.Values; - Look_For_Foreign : while Current /= Nil_String loop Element := Project_Tree.String_Elements. @@ -7698,6 +7702,7 @@ package body Make is declare Norm : constant String := Normalize_Pathname (Argv); + begin if Norm (Norm'Last) = Directory_Separator then Object_Directory_Path := new String'(Norm); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 307ec6ffccc..e9891219328 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -329,8 +329,8 @@ package body Makeutl is end if; return Normalize_Pathname - (Exec (Exec'First .. Path_Last - 4), - Resolve_Links => Opt.Follow_Links_For_Dirs) + (Exec (Exec'First .. Path_Last - 4), + Resolve_Links => Opt.Follow_Links_For_Dirs) & Directory_Separator; end Get_Install_Dir; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 1b1f5085984..ae04481ff20 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -80,8 +80,8 @@ package body Osint is -- Appends Suffix to Name and returns the new name function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type; - -- Convert OS format time to GNAT format time stamp. - -- Returns Empty_Time_Stamp if T is Invalid_Time + -- Convert OS format time to GNAT format time stamp. If T is Invalid_Time, + -- then returns Empty_Time_Stamp. function Executable_Prefix return String_Ptr; -- Returns the name of the root directory where the executable is stored. @@ -91,8 +91,8 @@ package body Osint is -- "/foo/bar/". Return "" if location is not recognized as described above. function Update_Path (Path : String_Ptr) return String_Ptr; - -- Update the specified path to replace the prefix with the location - -- where GNAT is installed. See the file prefix.c in GCC for details. + -- Update the specified path to replace the prefix with the location where + -- GNAT is installed. See the file prefix.c in GCC for details. procedure Locate_File (N : File_Name_Type; @@ -106,9 +106,11 @@ package body Osint is -- if T = Source, Dir is an index into the Src_Search_Directories table. -- Returns the File_Name_Type of the full file name if file found, or -- No_File if not found. + -- -- On exit, Found is set to the file that was found, and Attr to a cache of -- its attributes (at least those that have been computed so far). Reusing -- the cache will save some system calls. + -- -- Attr is always reset in this call to Unknown_Attributes, even in case of -- failure @@ -239,8 +241,9 @@ package body Osint is File : File_Name_Type; Attr : aliased File_Attributes; end record; + No_File_Info_Cache : constant File_Info_Cache := - (No_File, Unknown_Attributes); + (No_File, Unknown_Attributes); package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable ( Header_Num => File_Hash_Num, @@ -584,13 +587,13 @@ package body Osint is declare Norm : String_Ptr := Normalize_Directory_Name (Dir); - begin + begin -- Do nothing if the directory is already in the list. This saves -- system calls and avoid unneeded work for D in Lib_Search_Directories.First .. - Lib_Search_Directories.Last + Lib_Search_Directories.Last loop if Lib_Search_Directories.Table (D).all = Norm.all then Free (Norm); @@ -1002,10 +1005,13 @@ package body Osint is ----------------- function File_Length - (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer + (Name : C_File_Name; + Attr : access File_Attributes) return Long_Integer is function Internal - (F : Integer; N : C_File_Name; A : System.Address) return Long_Integer; + (F : Integer; + N : C_File_Name; + A : System.Address) return Long_Integer; pragma Import (C, Internal, "__gnat_file_length_attr"); begin return Internal (-1, Name, Attr.all'Address); @@ -1016,7 +1022,8 @@ package body Osint is --------------------- function File_Time_Stamp - (Name : C_File_Name; Attr : access File_Attributes) return OS_Time + (Name : C_File_Name; + Attr : access File_Attributes) return OS_Time is function Internal (N : C_File_Name; A : System.Address) return OS_Time; pragma Import (C, Internal, "__gnat_file_time_name_attr"); @@ -1036,13 +1043,13 @@ package body Osint is Get_Name_String (Name); - -- File_Time_Stamp will always return Invalid_Time if the file does not - -- exist, and OS_Time_To_GNAT_Time will convert this value to - -- Empty_Time_Stamp. Therefore we do not need to first test whether the - -- file actually exists, which saves a system call. + -- File_Time_Stamp will always return Invalid_Time if the file does + -- not exist, and OS_Time_To_GNAT_Time will convert this value to + -- Empty_Time_Stamp. Therefore we do not need to first test whether + -- the file actually exists, which saves a system call. return OS_Time_To_GNAT_Time - (File_Time_Stamp (Name_Buffer (1 .. Name_Len))); + (File_Time_Stamp (Name_Buffer (1 .. Name_Len))); end File_Stamp; function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is @@ -1084,9 +1091,9 @@ package body Osint is begin -- If we are looking for a config file, look only in the current - -- directory, i.e. return input argument unchanged. Also look - -- only in the current directory if we are looking for a .dg - -- file (happens in -gnatD mode). + -- directory, i.e. return input argument unchanged. Also look only in + -- the curren directory if we are looking for a .dg file (happens in + -- -gnatD mode). if T = Config or else (Debug_Generated_Code @@ -2392,10 +2399,13 @@ package body Osint is if Opt.Check_Object_Consistency then -- On most systems, this does not result in an extra system call - Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time - (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr)); + + Current_Full_Lib_Stamp := + OS_Time_To_GNAT_Time + (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr)); -- ??? One system call here + Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name); if Current_Full_Obj_Stamp (1) = ' ' then @@ -2710,6 +2720,7 @@ package body Osint is is File : File_Name_Type; Attr : aliased File_Attributes; + begin if not File_Cache_Enabled then Find_File (N, T, File, Attr'Access); @@ -2722,8 +2733,9 @@ package body Osint is else Get_Name_String (File); Name_Buffer (Name_Len + 1) := ASCII.NUL; - return OS_Time_To_GNAT_Time - (File_Time_Stamp (Name_Buffer'Address, Attr'Access)); + return + OS_Time_To_GNAT_Time + (File_Time_Stamp (Name_Buffer'Address, Attr'Access)); end if; end Smart_File_Stamp; @@ -2757,8 +2769,10 @@ package body Osint is begin if not File_Cache_Enabled then Find_File (N, T, Info.File, Info.Attr'Access); + else Info := File_Name_Hash_Table.Get (N); + if Info.File = No_File then Find_File (N, T, Info.File, Info.Attr'Access); File_Name_Hash_Table.Set (N, Info); @@ -2801,8 +2815,7 @@ package body Osint is if Is_Directory_Separator (Name_Buffer (J)) then - -- Return the part of Name that follows this last directory - -- separator. + -- Return part of Name that follows this last directory separator Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len); Name_Len := Name_Len - J; @@ -2849,7 +2862,7 @@ package body Osint is Prefix_Flag : Integer) return Address; pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec"); - C_Host_Dir : String (1 .. Host_Dir'Length + 1); + C_Host_Dir : String (1 .. Host_Dir'Length + 1); Canonical_Dir_Addr : Address; Canonical_Dir_Len : Integer; @@ -2862,6 +2875,7 @@ package body Osint is else Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0); end if; + Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr); if Canonical_Dir_Len = 0 then diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 34b3f642fee..2fa256107ad 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -30,8 +30,8 @@ with Namet; use Namet; with Types; use Types; with System.Storage_Elements; -with System.OS_Lib; use System.OS_Lib; -with System; use System; +with System.OS_Lib; use System.OS_Lib; +with System; use System; pragma Elaborate_All (System.OS_Lib); -- For the call to function Get_Target_Object_Suffix in the private part @@ -234,10 +234,12 @@ package Osint is --------------------- -- File attributes -- --------------------- + -- The following subprograms offer services similar to those found in -- System.OS_Lib, but with the ability to extra multiple information from -- a single system call, depending on the system. This can result in fewer -- system calls when reused. + -- In all these subprograms, the requested value is either read from the -- File_Attributes parameter (resulting in no system call), or computed -- from the disk and then cached in the File_Attributes parameter (possibly @@ -249,27 +251,35 @@ package Osint is -- This must be initialized to Unknown_Attributes prior to the first call. function Is_Directory - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; function Is_Regular_File - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; function Is_Symbolic_Link - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; -- Return the type of the file, function File_Length - (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer; + (Name : C_File_Name; + Attr : access File_Attributes) return Long_Integer; -- Return the length (number of bytes) of the file function File_Time_Stamp - (Name : C_File_Name; Attr : access File_Attributes) return OS_Time; + (Name : C_File_Name; + Attr : access File_Attributes) return OS_Time; -- Return the time stamp of the file function Is_Readable_File - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; function Is_Executable_File - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; function Is_Writable_File - (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + (Name : C_File_Name; + Attr : access File_Attributes) return Boolean; -- Return the access rights for the file ------------------------- @@ -436,6 +446,7 @@ package Osint is -- The source file directory lookup penalty is incurred every single time -- the routines are called unless you have previously called -- Source_File_Data (Cache => True). See below. + -- -- The procedural version also returns some file attributes for the ALI -- file (to save on system calls later on). @@ -468,11 +479,11 @@ package Osint is -- Representation of Library Information -- ------------------------------------------- - -- Associated with each compiled source file is library information, - -- a string of bytes whose exact format is described in the body of - -- Lib.Writ. Compiling a source file generates this library information - -- for the compiled unit, and access the library information for units - -- that were compiled previously on which the unit being compiled depends. + -- Associated with each compiled source file is library information, a + -- string of bytes whose exact format is described in the body of Lib.Writ. + -- Compiling a source file generates this library information for the + -- compiled unit, and access the library information for units that were + -- compiled previously on which the unit being compiled depends. -- How this information is stored is up to the implementation of this -- package. At the interface level, this information is simply associated @@ -524,15 +535,14 @@ package Osint is -- include any directory information. The implementation is responsible -- for searching for the file in appropriate directories. -- - -- If Opt.Check_Object_Consistency is set to True then this routine - -- checks whether the object file corresponding to the Lib_File is - -- consistent with it. The object file is inconsistent if the object - -- does not exist or if it has an older time stamp than Lib_File. - -- This check is not performed when the Lib_File is "locked" (i.e. - -- read/only) because in this case the object file may be buried - -- in a library. In case of inconsistencies Read_Library_Info - -- behaves as if it did not find Lib_File (namely if Fatal_Err is - -- False, null is returned). + -- If Opt.Check_Object_Consistency is set to True then this routine checks + -- whether the object file corresponding to the Lib_File is consistent with + -- it. The object file is inconsistent if the object does not exist or if + -- it has an older time stamp than Lib_File. This check is not performed + -- when the Lib_File is "locked" (i.e. read/only) because in this case the + -- object file may be buried in a library. In case of inconsistencies + -- Read_Library_Info behaves as if it did not find Lib_File (namely if + -- Fatal_Err is False, null is returned). function Read_Library_Info_From_Full (Full_Lib_File : File_Name_Type; @@ -726,7 +736,7 @@ private type File_Attributes is array (1 .. File_Attributes_Size) - of System.Storage_Elements.Storage_Element; + of System.Storage_Elements.Storage_Element; for File_Attributes'Alignment use Standard'Maximum_Alignment; Unknown_Attributes : constant File_Attributes := (others => 0); diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 8c7a5d95d96..fe6216f82fa 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -213,9 +213,9 @@ package body Prj.Ext is declare New_Dir : constant String := - Normalize_Pathname - (Name_Buffer (First .. Last), - Resolve_Links => Opt.Follow_Links_For_Dirs); + Normalize_Pathname + (Name_Buffer (First .. Last), + Resolve_Links => Opt.Follow_Links_For_Dirs); begin -- If the absolute path was resolved and is different from diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 840214d2c64..da260f35c4a 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -239,8 +239,9 @@ package body Sem_Case is " alternatives must cover base type", Expr, Expr); else - Error_Msg_N ("subtype of expression is not static," & - " alternatives must cover base type!", Expr); + Error_Msg_N + ("subtype of expression is not static," + & " alternatives must cover base type!", Expr); end if; -- Otherwise the expression is not static, even if the bounds of the @@ -249,8 +250,8 @@ package body Sem_Case is elsif not Is_Entity_Name (Expr) then Error_Msg_N - ("subtype of expression is not static, " & - "alternatives must cover base type!", Expr); + ("subtype of expression is not static, " + & "alternatives must cover base type!", Expr); end if; end Explain_Non_Static_Bound; |