Skip to content

R
riscv-gcc-1
Commit d56e7acd by Arnaud Charlet
Options

[multiple changes] 

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.

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