Skip to content

R
riscv-gcc-1
Commit 5969611f by Robert Dewar Committed by Arnaud Charlet
Options

exp_ch7.adb, [...]: Minor reformatting. 

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb, make.adb, sem_ch10.adb, bindgen.adb, sem_res.adb,
	exp_ch4.adb, makeutl.adb: Minor reformatting.

From-SVN: r177365
parent 6367dd30
Showing with 68 additions and 46 deletions
gcc/ada/ChangeLog
2011-08-04 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, make.adb, sem_ch10.adb, bindgen.adb, sem_res.adb,
exp_ch4.adb, makeutl.adb: Minor reformatting.
2011-08-04 Emmanuel Briot <briot@adacore.com> 2011-08-04 Emmanuel Briot <briot@adacore.com>
* make.adb, makeutl.adb, makeutl.ads (Make): major refactoring. * make.adb, makeutl.adb, makeutl.ads (Make): major refactoring.
......
gcc/ada/bindgen.adb
...@@ -1665,6 +1665,10 @@ package body Bindgen is ...@@ -1665,6 +1665,10 @@ package body Bindgen is
procedure Gen_Header; procedure Gen_Header;
-- Generate the header of the finalization routine -- Generate the header of the finalization routine
----------------
-- Gen_Header --
----------------
procedure Gen_Header is procedure Gen_Header is
begin begin
WBI (" procedure finalize_library is"); WBI (" procedure finalize_library is");
...@@ -1685,6 +1689,8 @@ package body Bindgen is ...@@ -1685,6 +1689,8 @@ package body Bindgen is
WBI (" begin"); WBI (" begin");
end Gen_Header; end Gen_Header;
-- Start of processing for Gen_Finalize_Library_Ada
begin begin
for E in reverse Elab_Order.First .. Elab_Order.Last loop for E in reverse Elab_Order.First .. Elab_Order.Last loop
Unum := Elab_Order.Table (E); Unum := Elab_Order.Table (E);
...@@ -1954,7 +1960,7 @@ package body Bindgen is ...@@ -1954,7 +1960,7 @@ package body Bindgen is
if U.Unit_Kind /= 'p' or else U.Is_Generic then if U.Unit_Kind /= 'p' or else U.Is_Generic then
null; null;
-- That aren't an interface to a stand alone library -- .. that are not interfaces to a stand alone library
elsif U.SAL_Interface then elsif U.SAL_Interface then
null; null;
......
gcc/ada/exp_ch4.adb
...@@ -456,7 +456,7 @@ package body Exp_Ch4 is ...@@ -456,7 +456,7 @@ package body Exp_Ch4 is
then then
declare declare
Pool_Id : constant Entity_Id := Pool_Id : constant Entity_Id :=
Get_Global_Pool_For_Access_Type (Ptr_Typ); Get_Global_Pool_For_Access_Type (Ptr_Typ);
Scop : Node_Id := Cunit_Entity (Current_Sem_Unit); Scop : Node_Id := Cunit_Entity (Current_Sem_Unit);
begin begin
......
gcc/ada/exp_ch7.adb
...@@ -4078,9 +4078,13 @@ package body Exp_Ch7 is ...@@ -4078,9 +4078,13 @@ package body Exp_Ch7 is
function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is
begin begin
if Opt.True_VMS_Target -- Access types whose size is smaller than System.Address size can
and then Esize (T) = 32 -- exit only on VMS. We can't use the usual global pool which returns
then -- an object of type Address as truncation will make it invalid.
-- To handle this case, VMS has a dedicated global pool that returns
-- addresses that fit into 32 bit accesses.
if Opt.True_VMS_Target and then Esize (T) = 32 then
return RTE (RE_Global_Pool_32_Object); return RTE (RE_Global_Pool_32_Object);
else else
return RTE (RE_Global_Pool_Object); return RTE (RE_Global_Pool_Object);
......
gcc/ada/makeutl.adb
...@@ -1350,11 +1350,14 @@ package body Makeutl is ...@@ -1350,11 +1350,14 @@ package body Makeutl is
Base_Main : String) return Prj.Source_Id Base_Main : String) return Prj.Source_Id
is is
Spec_Source : Prj.Source_Id := No_Source; Spec_Source : Prj.Source_Id := No_Source;
Source : Prj.Source_Id := No_Source; Source : Prj.Source_Id;
Project : Project_Id := Root_Project; Project : Project_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
Suffix : File_Name_Type; Suffix : File_Name_Type;
begin begin
Source := No_Source;
Project := Root_Project;
while Source = No_Source while Source = No_Source
and then Project /= No_Project and then Project /= No_Project
loop loop
...@@ -1429,12 +1432,13 @@ package body Makeutl is ...@@ -1429,12 +1432,13 @@ package body Makeutl is
for J in reverse Names.First .. Names.Last loop for J in reverse Names.First .. Names.Last loop
declare declare
File : Main_Info := Names.Table (J); File : Main_Info := Names.Table (J);
Main_Id : File_Name_Type := File.File; Main_Id : File_Name_Type := File.File;
Main : constant String := Get_Name_String (Main_Id); Main : constant String :=
Base : constant String := Base_Name (Main); Get_Name_String (Main_Id);
Source : Prj.Source_Id := No_Source; Base : constant String := Base_Name (Main);
Is_Absolute : Boolean := False; Source : Prj.Source_Id := No_Source;
Is_Absolute : Boolean := False;
begin begin
if Base /= Main then if Base /= Main then
...@@ -1444,10 +1448,10 @@ package body Makeutl is ...@@ -1444,10 +1448,10 @@ package body Makeutl is
else else
declare declare
Absolute : constant String := Absolute : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Main, (Name => Main,
Directory => "", Directory => "",
Resolve_Links => False); Resolve_Links => False);
begin begin
File.File := Create_Name (Absolute); File.File := Create_Name (Absolute);
Main_Id := Create_Name (Base); Main_Id := Create_Name (Base);
...@@ -1504,15 +1508,19 @@ package body Makeutl is ...@@ -1504,15 +1508,19 @@ package body Makeutl is
end if; end if;
if Source = No_Source then if Source = No_Source then
-- Still not found ? Maybe we have a unit name
-- Still not found? Maybe we have a unit name
declare declare
Unit : constant Unit_Index := Unit : constant Unit_Index :=
Units_Htable.Get Units_Htable.Get
(File.Tree.Units_HT, Name_Id (Main_Id)); (File.Tree.Units_HT,
begin Name_Id (Main_Id));
begin
if Unit /= No_Unit_Index then if Unit /= No_Unit_Index then
Source := Unit.File_Names (Impl); Source := Unit.File_Names (Impl);
if Source = No_Source then if Source = No_Source then
Source := Unit.File_Names (Spec); Source := Unit.File_Names (Spec);
end if; end if;
...@@ -1527,9 +1535,7 @@ package body Makeutl is ...@@ -1527,9 +1535,7 @@ package body Makeutl is
-- to compile all the units from the same source -- to compile all the units from the same source
-- file. -- file.
if Source.Index /= 0 if Source.Index /= 0 and then File.Index = 0 then
and then File.Index = 0
then
Add_Multi_Unit_Sources (File.Tree, Source); Add_Multi_Unit_Sources (File.Tree, Source);
end if; end if;
...@@ -1564,8 +1570,7 @@ package body Makeutl is ...@@ -1564,8 +1570,7 @@ package body Makeutl is
Error_Msg_File_1 := Main_Id; Error_Msg_File_1 := Main_Id;
Error_Msg_Name_1 := Root_Project.Name; Error_Msg_Name_1 := Root_Project.Name;
Prj.Err.Error_Msg Prj.Err.Error_Msg
(Flags, (Flags, "{ is not a source of project %%",
"{ is not a source of project %%",
File.Location, Project); File.Location, Project);
end if; end if;
end if; end if;
...@@ -1832,8 +1837,10 @@ package body Makeutl is ...@@ -1832,8 +1837,10 @@ package body Makeutl is
elsif Sw'Length >= 4 elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL" and then (Sw (2 .. 3) = "aL"
or else Sw (2 .. 3) = "aO" or else
or else Sw (2 .. 3) = "aI") Sw (2 .. 3) = "aO"
or else
Sw (2 .. 3) = "aI")
then then
Start := 4; Start := 4;
...@@ -1923,7 +1930,6 @@ package body Makeutl is ...@@ -1923,7 +1930,6 @@ package body Makeutl is
Start := Finish; Start := Finish;
Finish := Finish - 1; Finish := Finish - 1;
while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop
Start := Start - 1; Start := Start - 1;
end loop; end loop;
...@@ -2644,6 +2650,7 @@ package body Makeutl is ...@@ -2644,6 +2650,7 @@ package body Makeutl is
Iter : Source_Iterator; Iter : Source_Iterator;
Source : Prj.Source_Id; Source : Prj.Source_Id;
begin begin
-- Nothing to do when "-u" was specified and some files were -- Nothing to do when "-u" was specified and some files were
-- specified on the command line -- specified on the command line
...@@ -2662,23 +2669,23 @@ package body Makeutl is ...@@ -2662,23 +2669,23 @@ package body Makeutl is
if Is_Compilable (Source) if Is_Compilable (Source)
and then and then
(All_Projects (All_Projects
or else Is_Extending (Project, Source.Project)) or else Is_Extending (Project, Source.Project))
and then not Source.Locally_Removed and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source and then Source.Replaced_By = No_Source
and then and then
(not Source.Project.Externally_Built (not Source.Project.Externally_Built
or else or else
(Is_Extending (Project, Source.Project) (Is_Extending (Project, Source.Project)
and then not Project.Externally_Built)) and then not Project.Externally_Built))
and then Source.Kind /= Sep and then Source.Kind /= Sep
and then Source.Path /= No_Path_Information and then Source.Path /= No_Path_Information
then then
if Source.Kind = Impl if Source.Kind = Impl
or else (Source.Unit /= No_Unit_Index or else (Source.Unit /= No_Unit_Index
and then Source.Kind = Spec and then Source.Kind = Spec
and then (Other_Part (Source) = No_Source and then (Other_Part (Source) = No_Source
or else or else
Other_Part (Source).Locally_Removed)) Other_Part (Source).Locally_Removed))
then then
if (Unit_Based if (Unit_Based
or else Source.Unit = No_Unit_Index or else Source.Unit = No_Unit_Index
...@@ -2712,9 +2719,9 @@ package body Makeutl is ...@@ -2712,9 +2719,9 @@ package body Makeutl is
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
Excluding_Shared_SALs : Boolean := False) Excluding_Shared_SALs : Boolean := False)
is is
Sfile : File_Name_Type; Sfile : File_Name_Type;
Afile : File_Name_Type; Afile : File_Name_Type;
Src_Id : Prj.Source_Id; Src_Id : Prj.Source_Id;
begin begin
-- Insert in the queue the unmarked source files (i.e. those which -- Insert in the queue the unmarked source files (i.e. those which
...@@ -2745,7 +2752,7 @@ package body Makeutl is ...@@ -2745,7 +2752,7 @@ package body Makeutl is
when Spec => when Spec =>
declare declare
Bdy : constant Prj.Source_Id := Bdy : constant Prj.Source_Id :=
Other_Part (Src_Id); Other_Part (Src_Id);
begin begin
if Bdy /= No_Source if Bdy /= No_Source
and then not Bdy.Locally_Removed and then not Bdy.Locally_Removed
...@@ -2838,9 +2845,9 @@ package body Makeutl is ...@@ -2838,9 +2845,9 @@ package body Makeutl is
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is
Data : constant Builder_Data_Access := Builder_Data (Tree); Data : constant Builder_Data_Access := Builder_Data (Tree);
All_Phases : constant Boolean := All_Phases : constant Boolean :=
not Option_Compile_Only not Option_Compile_Only
and then not Option_Bind_Only and then not Option_Bind_Only
and then not Option_Link_Only; and then not Option_Link_Only;
-- Whether the command line asked for all three phases. Depending on -- Whether the command line asked for all three phases. Depending on
-- the project settings, we might still disable some of the phases. -- the project settings, we might still disable some of the phases.
......
gcc/ada/sem_ch10.adb
...@@ -2602,7 +2602,7 @@ package body Sem_Ch10 is ...@@ -2602,7 +2602,7 @@ package body Sem_Ch10 is
Par_Name := Entity (Pref); Par_Name := Entity (Pref);
end if; end if;
-- Guard against missing or misspelled child units. -- Guard against missing or misspelled child units
if Present (Par_Name) then if Present (Par_Name) then
Set_Entity_With_Style_Check (Pref, Par_Name); Set_Entity_With_Style_Check (Pref, Par_Name);
......
gcc/ada/sem_res.adb
...@@ -4355,7 +4355,7 @@ package body Sem_Res is ...@@ -4355,7 +4355,7 @@ package body Sem_Res is
then then
Error_Msg_N Error_Msg_N
("cannot activate task before body seen?", N); ("cannot activate task before body seen?", N);
Error_Msg_N ("\Program_Error will be raised at run time", N); Error_Msg_N ("\Program_Error will be raised at run time?", N);
end if; end if;
end Resolve_Allocator; end Resolve_Allocator;
......
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