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>
* make.adb, makeutl.adb, makeutl.ads (Make): major refactoring.
......
gcc/ada/bindgen.adb
......@@ -1665,6 +1665,10 @@ package body Bindgen is
procedure Gen_Header;
-- Generate the header of the finalization routine
----------------
-- Gen_Header --
----------------
procedure Gen_Header is
begin
WBI (" procedure finalize_library is");
......@@ -1685,6 +1689,8 @@ package body Bindgen is
WBI (" begin");
end Gen_Header;
-- Start of processing for Gen_Finalize_Library_Ada
begin
for E in reverse Elab_Order.First .. Elab_Order.Last loop
Unum := Elab_Order.Table (E);
......@@ -1954,7 +1960,7 @@ package body Bindgen is
if U.Unit_Kind /= 'p' or else U.Is_Generic then
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
null;
......
gcc/ada/exp_ch4.adb
......@@ -456,7 +456,7 @@ package body Exp_Ch4 is
then
declare
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);
begin
......
gcc/ada/exp_ch7.adb
......@@ -4078,9 +4078,13 @@ package body Exp_Ch7 is
function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is
begin
if Opt.True_VMS_Target
and then Esize (T) = 32
then
-- Access types whose size is smaller than System.Address size can
-- exit only on VMS. We can't use the usual global pool which returns
-- 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);
else
return RTE (RE_Global_Pool_Object);
......
gcc/ada/makeutl.adb
......@@ -1350,11 +1350,14 @@ package body Makeutl is
Base_Main : String) return Prj.Source_Id
is
Spec_Source : Prj.Source_Id := No_Source;
Source : Prj.Source_Id := No_Source;
Project : Project_Id := Root_Project;
Source : Prj.Source_Id;
Project : Project_Id;
Iter : Source_Iterator;
Suffix : File_Name_Type;
begin
Source := No_Source;
Project := Root_Project;
while Source = No_Source
and then Project /= No_Project
loop
......@@ -1429,12 +1432,13 @@ package body Makeutl is
for J in reverse Names.First .. Names.Last loop
declare
File : Main_Info := Names.Table (J);
Main_Id : File_Name_Type := File.File;
Main : constant String := Get_Name_String (Main_Id);
Base : constant String := Base_Name (Main);
Source : Prj.Source_Id := No_Source;
Is_Absolute : Boolean := False;
File : Main_Info := Names.Table (J);
Main_Id : File_Name_Type := File.File;
Main : constant String :=
Get_Name_String (Main_Id);
Base : constant String := Base_Name (Main);
Source : Prj.Source_Id := No_Source;
Is_Absolute : Boolean := False;
begin
if Base /= Main then
......@@ -1444,10 +1448,10 @@ package body Makeutl is
else
declare
Absolute : constant String :=
Normalize_Pathname
(Name => Main,
Directory => "",
Resolve_Links => False);
Normalize_Pathname
(Name => Main,
Directory => "",
Resolve_Links => False);
begin
File.File := Create_Name (Absolute);
Main_Id := Create_Name (Base);
......@@ -1504,15 +1508,19 @@ package body Makeutl is
end if;
if Source = No_Source then
-- Still not found ? Maybe we have a unit name
-- Still not found? Maybe we have a unit name
declare
Unit : constant Unit_Index :=
Units_Htable.Get
(File.Tree.Units_HT, Name_Id (Main_Id));
begin
Units_Htable.Get
(File.Tree.Units_HT,
Name_Id (Main_Id));
begin
if Unit /= No_Unit_Index then
Source := Unit.File_Names (Impl);
if Source = No_Source then
Source := Unit.File_Names (Spec);
end if;
......@@ -1527,9 +1535,7 @@ package body Makeutl is
-- to compile all the units from the same source
-- file.
if Source.Index /= 0
and then File.Index = 0
then
if Source.Index /= 0 and then File.Index = 0 then
Add_Multi_Unit_Sources (File.Tree, Source);
end if;
......@@ -1564,8 +1570,7 @@ package body Makeutl is
Error_Msg_File_1 := Main_Id;
Error_Msg_Name_1 := Root_Project.Name;
Prj.Err.Error_Msg
(Flags,
"{ is not a source of project %%",
(Flags, "{ is not a source of project %%",
File.Location, Project);
end if;
end if;
......@@ -1832,8 +1837,10 @@ package body Makeutl is
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL"
or else Sw (2 .. 3) = "aO"
or else Sw (2 .. 3) = "aI")
or else
Sw (2 .. 3) = "aO"
or else
Sw (2 .. 3) = "aI")
then
Start := 4;
......@@ -1923,7 +1930,6 @@ package body Makeutl is
Start := Finish;
Finish := Finish - 1;
while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop
Start := Start - 1;
end loop;
......@@ -2644,6 +2650,7 @@ package body Makeutl is
Iter : Source_Iterator;
Source : Prj.Source_Id;
begin
-- Nothing to do when "-u" was specified and some files were
-- specified on the command line
......@@ -2662,23 +2669,23 @@ package body Makeutl is
if Is_Compilable (Source)
and then
(All_Projects
or else Is_Extending (Project, Source.Project))
or else Is_Extending (Project, Source.Project))
and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source
and then
(not Source.Project.Externally_Built
or else
(Is_Extending (Project, Source.Project)
and then not Project.Externally_Built))
or else
(Is_Extending (Project, Source.Project)
and then not Project.Externally_Built))
and then Source.Kind /= Sep
and then Source.Path /= No_Path_Information
then
if Source.Kind = Impl
or else (Source.Unit /= No_Unit_Index
and then Source.Kind = Spec
and then (Other_Part (Source) = No_Source
or else
Other_Part (Source).Locally_Removed))
and then Source.Kind = Spec
and then (Other_Part (Source) = No_Source
or else
Other_Part (Source).Locally_Removed))
then
if (Unit_Based
or else Source.Unit = No_Unit_Index
......@@ -2712,9 +2719,9 @@ package body Makeutl is
Project_Tree : Project_Tree_Ref;
Excluding_Shared_SALs : Boolean := False)
is
Sfile : File_Name_Type;
Afile : File_Name_Type;
Src_Id : Prj.Source_Id;
Sfile : File_Name_Type;
Afile : File_Name_Type;
Src_Id : Prj.Source_Id;
begin
-- Insert in the queue the unmarked source files (i.e. those which
......@@ -2745,7 +2752,7 @@ package body Makeutl is
when Spec =>
declare
Bdy : constant Prj.Source_Id :=
Other_Part (Src_Id);
Other_Part (Src_Id);
begin
if Bdy /= No_Source
and then not Bdy.Locally_Removed
......@@ -2838,9 +2845,9 @@ package body Makeutl is
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is
Data : constant Builder_Data_Access := Builder_Data (Tree);
All_Phases : constant Boolean :=
not Option_Compile_Only
and then not Option_Bind_Only
and then not Option_Link_Only;
not Option_Compile_Only
and then not Option_Bind_Only
and then not Option_Link_Only;
-- Whether the command line asked for all three phases. Depending on
-- 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
Par_Name := Entity (Pref);
end if;
-- Guard against missing or misspelled child units.
-- Guard against missing or misspelled child units
if Present (Par_Name) then
Set_Entity_With_Style_Check (Pref, Par_Name);
......
gcc/ada/sem_res.adb
......@@ -4355,7 +4355,7 @@ package body Sem_Res is
then
Error_Msg_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 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