OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

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

	* bindgen.adb, einfo.adb, sem_ch12.adb, s-tasren.adb, sem_res.adb,
	makeutl.adb, prj-nmsc.adb, opt.ads, prj-env.adb: Minor reformatting
	* gcc-interface/Make-lang.in: Update dependencies.

From-SVN: r177356
This commit is contained in:
Robert Dewar 2011-08-04 10:22:27 +00:00 committed by Arnaud Charlet
parent c2db4b320d
commit 2598ee6d90
11 changed files with 184 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -1,3 +1,9 @@
2011-08-04 Robert Dewar <dewar@adacore.com>
* bindgen.adb, einfo.adb, sem_ch12.adb, s-tasren.adb, sem_res.adb,
makeutl.adb, prj-nmsc.adb, opt.ads, prj-env.adb: Minor reformatting
* gcc-interface/Make-lang.in: Update dependencies.
2011-08-04 Arnaud Charlet <charlet@adacore.com>
* prj-env.adb: Remove local debug traces.

19
gcc/ada/bindgen.adb
View File

@ -2219,11 +2219,15 @@ package body Bindgen is
WBI (" Break_Start;");
if CodePeer_Mode then
-- Bypass Ada_Main_Program; its Import pragma confuses CodePeer.
-- Bypass Ada_Main_Program, its Import pragma confuses CodePeer
Get_Name_String (Units.Table (First_Unit_Entry).Uname);
declare
Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
-- strip trailing "%b"
-- Strip trailing "%b"
begin
if ALIs.Table (ALIs.First).Main_Program = Proc then
WBI (" " & Callee_Name & ";");
@ -2231,8 +2235,10 @@ package body Bindgen is
WBI (" Result := " & Callee_Name & ";");
end if;
end;
elsif ALIs.Table (ALIs.First).Main_Program = Proc then
WBI (" Ada_Main_Program;");
else
WBI (" Result := Ada_Main_Program;");
end if;
@ -3076,10 +3082,14 @@ package body Bindgen is
end if;
if CodePeer_Mode then
-- For CodePeer, main program is not called via an Import pragma.
-- For CodePeer, main program is not called via an Import pragma
Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-- Note: trailing "%b" is stripped.
WBI ("with " & Name_Buffer (1 .. Name_Len - 2) & ";");
-- strip trailing "%b"
end if;
WBI ("");
@ -3088,6 +3098,7 @@ package body Bindgen is
WBI ("");
-- Generate externals for elaboration entities
Gen_Elab_Externals_Ada;
if not Suppress_Standard_Library_On_Target then

5
gcc/ada/einfo.adb
View File

@ -409,7 +409,6 @@ package body Einfo is
-- Is_Compilation_Unit Flag149
-- Has_Pragma_Elaborate_Body Flag150
-- (unused) Flag151
-- Entry_Accepted Flag152
-- Is_Obsolescent Flag153
-- Has_Per_Object_Constraint Flag154
@ -519,9 +518,11 @@ package body Einfo is
-- Is_Safe_To_Reevaluate Flag249
-- Has_Predicates Flag250
-- (unused) Flag251
-- Is_Processed_Transient Flag252
-- Is_Postcondition_Proc Flag253
-- (unused) Flag151
-- (unused) Flag251
-- (unused) Flag254
-----------------------

13
gcc/ada/gcc-interface/Make-lang.in
View File

@ -1301,8 +1301,9 @@ ada/alfa.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/aspects.ads ada/atree.ads ada/atree.adb ada/casing.ads \
ada/debug.ads ada/einfo.ads ada/gnat.ads ada/g-htable.ads \
ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/interfac.ads \
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads \
ada/output.ads ada/output.adb ada/put_alfa.ads ada/put_alfa.adb \
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb \
ada/nmake.ads ada/opt.ads ada/output.ads ada/output.adb \
ada/put_alfa.ads ada/put_alfa.adb ada/sem_util.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
@ -3322,10 +3323,10 @@ ada/put_alfa.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/put_scos.ads ada/put_scos.adb ada/scos.ads \
ada/scos.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads \
ada/unchdeal.ads
ada/g-table.adb ada/par_sco.ads ada/put_scos.ads ada/put_scos.adb \
ada/scos.ads ada/scos.adb ada/system.ads ada/s-exctab.ads \
ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
ada/unchconv.ads ada/unchdeal.ads
ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \

154
gcc/ada/makeutl.adb
View File

@ -239,6 +239,7 @@ package body Makeutl is
Unit_Name := SD.Subunit_Name;
if Unit_Name = No_Name then
-- Check if this source file has been replaced by a source with
-- a different file name.
@ -902,10 +903,11 @@ package body Makeutl is
if Source.Language.Config.Dependency_Kind /= None then
declare
Dep_Path : constant String :=
Normalize_Pathname
(Name => Get_Name_String (Source.Dep_Name),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
Normalize_Pathname
(Name =>
Get_Name_String (Source.Dep_Name),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
begin
Source.Dep_Path := Create_Name (Dep_Path);
Source.Dep_TS := Osint.Unknown_Attributes;
@ -974,9 +976,9 @@ package body Makeutl is
(Source.Object, Source.Language.Config.Dependency_Kind);
end if;
-- Find the object file for that source. It could be either in
-- the current project or in an extended project (it might actually
-- not exist yet in the ultimate extending project, but if not found
-- Find the object file for that source. It could be either in the
-- current project or in an extended project (it might actually not
-- exist yet in the ultimate extending project, but if not found
-- elsewhere that's where we'll expect to find it).
Obj_Proj := Source.Project;
@ -1000,7 +1002,7 @@ package body Makeutl is
-- For specs, we do not check object files if there is a body.
-- This saves a system call. On the other hand, we do need to
-- know the object_path, in case the user has passed the .ads
-- on the command line to compile the spec only
-- on the command line to compile the spec only.
if Source.Kind /= Spec
or else Source.Unit = No_Unit_Index
@ -1147,8 +1149,8 @@ package body Makeutl is
In_Package => Linker_Package,
Shared => In_Tree.Shared);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
-- If attribute is present, add the project with the attribute to
-- table Linker_Opts.
if Options /= Nil_Variable_Value then
Linker_Opts.Increment_Last;
@ -1259,6 +1261,7 @@ package body Makeutl is
if Tree /= null then
Builder_Data (Tree).Number_Of_Mains :=
Builder_Data (Tree).Number_Of_Mains + 1;
else
Mains.Count_Of_Mains_With_No_Tree :=
Mains.Count_Of_Mains_With_No_Tree + 1;
@ -1295,9 +1298,10 @@ package body Makeutl is
is
Iter : Source_Iterator;
Src : Prj.Source_Id;
begin
Debug_Output
("Found multi-unit source file in project", Source.Project.Name);
("found multi-unit source file in project", Source.Project.Name);
Iter := For_Each_Source
(In_Tree => Tree, Project => Source.Project);
@ -1310,7 +1314,7 @@ package body Makeutl is
then
if Src.File = Source.File then
Debug_Output
("Add main in project, index=" & Src.Index'Img);
("add main in project, index=" & Src.Index'Img);
end if;
Names.Increment_Last;
@ -1335,7 +1339,8 @@ package body Makeutl is
-----------------
procedure Do_Complete
(Project : Project_Id; Tree : Project_Tree_Ref) is
(Project : Project_Id; Tree : Project_Tree_Ref)
is
begin
if Mains.Number_Of_Mains (Tree) > 0
or else Mains.Count_Of_Mains_With_No_Tree > 0
@ -1346,13 +1351,14 @@ 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);
Source : Prj.Source_Id := No_Source;
Suffix : File_Name_Type;
Iter : Source_Iterator;
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);
Source : Prj.Source_Id := No_Source;
Is_Absolute : Boolean := False;
Suffix : File_Name_Type;
Iter : Source_Iterator;
begin
if Base_Name (Main) /= Main then
@ -1370,6 +1376,7 @@ package body Makeutl is
-- If no project or tree was specified for the main, it
-- came from the command line. In this case, it needs to
-- belong to the root project.
-- Note that the assignments below will not modify inside
-- the table itself.
@ -1384,16 +1391,15 @@ package body Makeutl is
if File.Source = null then
if Current_Verbosity = High then
Debug_Output
("Search for main """ & Main
("search for main """ & Main
& '"' & File.Index'Img & " in "
& Get_Name_String (Debug_Name (File.Tree))
& ", project", Project.Name);
end if;
-- First, look for the main as specified.
-- We need to search for the base name though, and
-- if needed check later that we found the correct
-- file.
-- First, look for the main as specified. We need to
-- search for the base name though, and if needed
-- check later that we found the correct file.
Source := Find_Source
(In_Tree => File.Tree,
@ -1402,13 +1408,16 @@ package body Makeutl is
Index => File.Index);
if Source = No_Source then
-- Now look for the main with a body suffix
declare
-- Main already has a canonical casing
Main : constant String :=
Get_Name_String (Main_Id);
Project : Project_Id;
begin
Project := File.Project;
while Source = No_Source
@ -1452,7 +1461,7 @@ package body Makeutl is
File.File
then
Debug_Output
("Found a non-matching file",
("found a non-matching file",
Name_Id (Source.Path.Display_Name));
Source := No_Source;
end if;
@ -1460,10 +1469,11 @@ package body Makeutl is
end if;
if Source /= No_Source then
-- If we have found a multi-unit source file but
-- did not specify an index initially, we'll need
-- to compile all the units from the same source
-- file
-- file.
if Source.Index /= 0
and then File.Index = 0
@ -1474,8 +1484,8 @@ package body Makeutl is
-- Now update the original Main, otherwise it will
-- be reported as not found.
Debug_Output ("Found main in project",
Source.Project.Name);
Debug_Output
("found main in project", Source.Project.Name);
Names.Table (J).File := Source.File;
Names.Table (J).Project := File.Project;
@ -1483,8 +1493,7 @@ package body Makeutl is
Names.Table (J).Tree := File.Tree;
Builder_Data (File.Tree).Number_Of_Mains :=
Builder_Data (File.Tree).Number_Of_Mains
+ 1;
Builder_Data (File.Tree).Number_Of_Mains + 1;
Mains.Count_Of_Mains_With_No_Tree :=
Mains.Count_Of_Mains_With_No_Tree - 1;
end if;
@ -1492,6 +1501,7 @@ package body Makeutl is
Names.Table (J).Source := Source;
elsif File.Location /= No_Location then
-- If the main is declared in package Builder of
-- the main project, report an error. If the main
-- is on the command line, it may be a main from
@ -1551,7 +1561,8 @@ package body Makeutl is
Project_Tree : Project_Tree_Ref)
is
procedure Add_Mains_From_Project
(Project : Project_Id; Tree : Project_Tree_Ref);
(Project : Project_Id;
Tree : Project_Tree_Ref);
-- Add the main units from this project into Mains.
-- This takes into account the aggregated projects
@ -1565,15 +1576,18 @@ package body Makeutl is
is
List : String_List_Id;
Element : String_Element;
begin
if Number_Of_Mains (Tree) = 0
and then Mains.Count_Of_Mains_With_No_Tree = 0
then
Debug_Output ("Add_Mains_From_Project", Project.Name);
Debug_Output ("add_Mains_From_Project", Project.Name);
List := Project.Mains;
if List /= Prj.Nil_String then
-- The attribute Main is not an empty list.
-- Get the mains in the list
-- The attribute Main is not an empty list. Get the mains in
-- the list.
while List /= Prj.Nil_String loop
Element := Tree.Shared.String_Elements.Table (List);
@ -1962,10 +1976,10 @@ package body Makeutl is
Index : Int := 0) return Boolean;
-- Returns True if the unit was previously marked
Q_Processed : Natural := 0;
Q_Initialized : Boolean := False;
Q_Processed : Natural := 0;
Q_Initialized : Boolean := False;
Q_First : Natural := 1;
Q_First : Natural := 1;
-- Points to the first valid element in the queue
One_Queue_Per_Obj_Dir : Boolean := False;
@ -1995,12 +2009,14 @@ package body Makeutl is
if S.Id.In_The_Queue then
return True;
end if;
S.Id.In_The_Queue := True;
when Format_Gnatmake =>
if Is_Marked (S.File, S.Index) then
return True;
end if;
Mark (S.File, Index => S.Index);
end case;
@ -2065,7 +2081,8 @@ package body Makeutl is
function Is_Marked
(Source_File : File_Name_Type;
Index : Int := 0) return Boolean is
Index : Int := 0) return Boolean
is
begin
return Marks.Get (K => (File => Source_File, Index => Index));
end Is_Marked;
@ -2182,8 +2199,7 @@ package body Makeutl is
function Insert_No_Roots (Source : Source_Info) return Boolean is
begin
pragma Assert
(Source.Format = Format_Gnatmake
or else Source.Id /= No_Source);
(Source.Format = Format_Gnatmake or else Source.Id /= No_Source);
-- Only insert in the Q if it is not already done, to avoid
-- simultaneous compilations if -jnnn is used.
@ -2223,7 +2239,8 @@ package body Makeutl is
------------
function Insert
(Source : Source_Info; With_Roots : Boolean := False) return Boolean
(Source : Source_Info;
With_Roots : Boolean := False) return Boolean
is
Root_Arr : Array_Element_Id;
Roots : Variable_Value;
@ -2234,19 +2251,22 @@ package body Makeutl is
Root_Pattern : Regexp;
Root_Found : Boolean;
Roots_Found : Boolean;
Dummy : Boolean;
Root_Source : Prj.Source_Id;
Iter : Source_Iterator;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
if not Insert_No_Roots (Source) then
-- Was already in the queue
return False;
end if;
if With_Roots and then Source.Format = Format_Gprbuild then
Debug_Output ("Looking for roots of", Name_Id (Source.Id.File));
Debug_Output ("looking for roots of", Name_Id (Source.Id.File));
Root_Arr :=
Prj.Util.Value_Of
@ -2305,10 +2325,10 @@ package body Makeutl is
Pat_Root := False;
for J in 1 .. Name_Len loop
if Name_Buffer (J) not in 'a' .. 'z'
and then Name_Buffer (J) not in '0' .. '9'
and then Name_Buffer (J) /= '_'
and then Name_Buffer (J) /= '.'
if Name_Buffer (J) not in 'a' .. 'z' and then
Name_Buffer (J) not in '0' .. '9' and then
Name_Buffer (J) /= '_' and then
Name_Buffer (J) /= '.'
then
Pat_Root := True;
exit;
@ -2349,7 +2369,7 @@ package body Makeutl is
else
Root_Found :=
Root_Source.Unit /= No_Unit_Index
and then Root_Source.Unit.Name = Unit_Name;
and then Root_Source.Unit.Name = Unit_Name;
end if;
if Root_Found then
@ -2420,7 +2440,8 @@ package body Makeutl is
------------
procedure Insert
(Source : Source_Info; With_Roots : Boolean := False)
(Source : Source_Info;
With_Roots : Boolean := False)
is
Discard : Boolean;
pragma Unreferenced (Discard);
@ -2530,8 +2551,8 @@ package body Makeutl is
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref);
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is
Unit_Based : constant Boolean :=
Unique_Compile
or else not Builder_Data (Tree).Closure_Needed;
Unique_Compile
or else not Builder_Data (Tree).Closure_Needed;
-- When Unit_Based is True, put in the queue all compilable
-- sources including the unit based (Ada) one. When Unit_Based is
-- False, put the Ada sources only when they are in a library
@ -2564,7 +2585,7 @@ package body Makeutl is
(not Source.Project.Externally_Built
or else
(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.Path /= No_Path_Information
then
@ -2572,12 +2593,12 @@ package body Makeutl is
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))
or else
Other_Part (Source).Locally_Removed))
then
if (Unit_Based
or else Source.Unit = No_Unit_Index
or else Source.Project.Library)
or else Source.Unit = No_Unit_Index
or else Source.Project.Library)
and then not Is_Subunit (Source)
then
Queue.Insert
@ -2627,9 +2648,9 @@ package body Makeutl is
if Sfile /= No_File then
Afile := ALI.Withs.Table (K).Afile;
Src_Id := Source_Files_Htable.Get
(Project_Tree.Source_Files_HT, Sfile);
Src_Id := Source_Files_Htable.Get
(Project_Tree.Source_Files_HT, Sfile);
while Src_Id /= No_Source loop
Initialize_Source_Record (Src_Id);
@ -2667,10 +2688,10 @@ package body Makeutl is
-- If Excluding_Shared_SALs is True, do not insert in the
-- queue the sources of a shared Stand-Alone Library.
if Src_Id /= No_Source and then
(not Excluding_Shared_SALs or else
not Src_Id.Project.Standalone_Library or else
Src_Id.Project.Library_Kind = Static)
if Src_Id /= No_Source
and then (not Excluding_Shared_SALs
or else not Src_Id.Project.Standalone_Library
or else Src_Id.Project.Library_Kind = Static)
then
Queue.Insert
(Source => (Format => Format_Gprbuild,
@ -2692,6 +2713,7 @@ package body Makeutl is
(Binding_Data_Record, Binding_Data);
TmpB, Binding : Binding_Data := Data.Binding;
begin
while Binding /= null loop
TmpB := Binding.Next;
@ -2744,6 +2766,7 @@ package body Makeutl is
begin
if Option_Unique_Compile then
-- If -u or -U is specified on the command line, disregard any -c,
-- -b or -l switch: only perform compilation.
@ -2757,11 +2780,11 @@ package body Makeutl is
Data.Need_Compilation := All_Phases or Option_Compile_Only;
Data.Need_Binding := All_Phases or Option_Bind_Only;
Data.Need_Linking := (All_Phases or Option_Link_Only)
and then Has_Mains;
and Has_Mains;
end if;
if Current_Verbosity = High then
Debug_Output ("Compilation phases: "
Debug_Output ("compilation phases: "
& " compile=" & Data.Need_Compilation'Img
& " bind=" & Data.Need_Binding'Img
& " link=" & Data.Need_Linking'Img
@ -2772,6 +2795,7 @@ package body Makeutl is
end Do_Compute;
procedure Compute_All is new For_Project_And_Aggregated (Do_Compute);
begin
Compute_All (Root_Project, Tree);
end Compute_Compilation_Phases;

2
gcc/ada/opt.ads
View File

@ -328,7 +328,7 @@ package Opt is
-- of withing a package and using none of the entities in the package.
CodePeer_Mode : Boolean := False;
-- GNAT
-- GNAT, GNATBIND
-- Enable full CodePeer mode (SCIL generation, disable switches that
-- interact badly with it, etc...).

2
gcc/ada/prj-env.adb
View File

@ -476,7 +476,7 @@ package body Prj.Env is
File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
Current_Naming : Naming_Id;
Current_Naming : Naming_Id;
procedure Check
(Project : Project_Id;

98
gcc/ada/prj-nmsc.adb
View File

@ -599,8 +599,8 @@ package body Prj.Nmsc is
end if;
return Filename'Length >= Suf'Length + Min_Prefix_Length
and then Filename
(Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
and then
Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
end;
end Suffix_Matches;
@ -789,7 +789,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Debug_Indent;
Write_Str ("Adding source File: ");
Write_Str ("adding source File: ");
Write_Str (Get_Name_String (Display_File));
if Index /= 0 then
@ -947,7 +947,7 @@ package body Prj.Nmsc is
begin
if Path.Name /= Project.Path.Name then
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
-- For usual "with" statement, this phase will have been done when
-- parsing the project itself. However, for aggregate projects, we
@ -965,7 +965,7 @@ package body Prj.Nmsc is
Add_Aggregated_Project (Project, Path => Path.Name);
else
Debug_Output ("Pattern returned the aggregate itself, ignored");
Debug_Output ("pattern returned the aggregate itself, ignored");
end if;
end Found_Project_File;
@ -1064,7 +1064,7 @@ package body Prj.Nmsc is
Prj_Data : Project_Processing_Data;
begin
Debug_Increase_Indent ("Check", Project.Name);
Debug_Increase_Indent ("check", Project.Name);
Initialize (Prj_Data, Project);
@ -1105,7 +1105,7 @@ package body Prj.Nmsc is
Free (Prj_Data);
Debug_Decrease_Indent ("Done Check");
Debug_Decrease_Indent ("done check");
end Check;
--------------------
@ -2709,9 +2709,9 @@ package body Prj.Nmsc is
end if;
if Project.Externally_Built then
Debug_Output ("Project is externally built");
Debug_Output ("project is externally built");
else
Debug_Output ("Project is not externally built");
Debug_Output ("project is not externally built");
end if;
end Check_If_Externally_Built;
@ -3519,7 +3519,7 @@ package body Prj.Nmsc is
if Lang = null then
Debug_Output
("Ignoring spec naming data (lang. not in project): ",
("ignoring spec naming data (lang. not in project): ",
Lang_Name);
else
@ -3542,7 +3542,7 @@ package body Prj.Nmsc is
if Lang = null then
Debug_Output
("Ignoring impl naming data (lang. not in project): ",
("ignoring impl naming data (lang. not in project): ",
Lang_Name);
else
Value := Shared.Array_Elements.Table (Impls).Value;
@ -3570,10 +3570,10 @@ package body Prj.Nmsc is
and then Project.Qualifier /= Configuration
then
Naming := Shared.Packages.Table (Naming_Id);
Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
Debug_Increase_Indent ("checking package Naming for ", Project.Name);
Initialize_Naming_Data;
Check_Naming;
Debug_Decrease_Indent ("Done checking package naming");
Debug_Decrease_Indent ("done checking package naming");
end if;
end Check_Package_Naming;
@ -3761,7 +3761,7 @@ package body Prj.Nmsc is
and then Project.Library_Name = No_Name
then
Debug_Indent;
Write_Line ("No library name");
Write_Line ("no library name");
end if;
else
@ -3779,7 +3779,7 @@ package body Prj.Nmsc is
pragma Assert (Lib_Dir.Kind = Single);
if not Library_Directory_Present then
Debug_Output ("No library directory");
Debug_Output ("no library directory");
else
-- Find path name (unless inherited), check that it is a directory
@ -3972,7 +3972,7 @@ package body Prj.Nmsc is
else
if Lib_ALI_Dir.Value = Empty_String then
Debug_Output ("No library ALI directory specified");
Debug_Output ("no library ALI directory specified");
Project.Library_ALI_Dir := Project.Library_Dir;
else
@ -4108,7 +4108,7 @@ package body Prj.Nmsc is
pragma Assert (Lib_Version.Kind = Single);
if Lib_Version.Value = Empty_String then
Debug_Output ("No library version specified");
Debug_Output ("no library version specified");
else
Project.Lib_Internal_Name := Lib_Version.Value;
@ -4117,7 +4117,7 @@ package body Prj.Nmsc is
pragma Assert (The_Lib_Kind.Kind = Single);
if The_Lib_Kind.Value = Empty_String then
Debug_Output ("No library kind specified");
Debug_Output ("no library kind specified");
else
Get_Name_String (The_Lib_Kind.Value);
@ -4202,7 +4202,7 @@ package body Prj.Nmsc is
end if;
if Project.Library then
Debug_Output ("This is a library project file");
Debug_Output ("this is a library project file");
Check_Library (Project.Extends, Extends => True);
@ -5082,7 +5082,7 @@ package body Prj.Nmsc is
-- The directory is in the list if List is not Nil_String
if not Remove_Source_Dirs and then List = Nil_String then
Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
Debug_Output ("adding source dir=", Name_Id (Path.Display_Name));
String_Element_Table.Increment_Last (Shared.String_Elements);
Element :=
@ -5159,7 +5159,7 @@ package body Prj.Nmsc is
-- Start of processing for Get_Directories
begin
Debug_Output ("Starting to look for directories");
Debug_Output ("starting to look for directories");
-- Set the object directory to its default which may be nil, if there
-- is no sources in the project.
@ -5230,7 +5230,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
if Project.Object_Directory = No_Path_Information then
Debug_Output ("No object directory");
Debug_Output ("no object directory");
else
Write_Attr
("Object directory",
@ -5278,17 +5278,17 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
if Project.Exec_Directory = No_Path_Information then
Debug_Output ("No exec directory");
Debug_Output ("no exec directory");
else
Debug_Output
("Exec directory: ",
("exec directory: ",
Name_Id (Project.Exec_Directory.Display_Name));
end if;
end if;
-- Look for the source directories
Debug_Output ("Starting to look for source directories");
Debug_Output ("starting to look for source directories");
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
@ -5348,7 +5348,7 @@ package body Prj.Nmsc is
Resolve_Links => Opt.Follow_Links_For_Dirs);
end if;
Debug_Output ("Putting source directories in canonical cases");
Debug_Output ("putting source directories in canonical cases");
declare
Current : String_List_Id := Project.Source_Dirs;
@ -5439,7 +5439,7 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Debug_Output ("Opening """ & Path & '"');
Debug_Output ("opening """ & Path & '"');
end if;
-- Open the file
@ -5547,7 +5547,7 @@ package body Prj.Nmsc is
end if;
if Naming.Dot_Replacement = No_File then
Debug_Output ("No dot_replacement specified");
Debug_Output ("no dot_replacement specified");
return;
end if;
@ -5593,7 +5593,7 @@ package body Prj.Nmsc is
if Is_Letter (Filename (J))
and then not Is_Lower (Filename (J))
then
Debug_Output ("Invalid casing");
Debug_Output ("invalid casing");
return;
end if;
end loop;
@ -5603,7 +5603,7 @@ package body Prj.Nmsc is
if Is_Letter (Filename (J))
and then not Is_Upper (Filename (J))
then
Debug_Output ("Invalid casing");
Debug_Output ("invalid casing");
return;
end if;
end loop;
@ -5624,7 +5624,7 @@ package body Prj.Nmsc is
if Dot_Repl /= "." then
for Index in Filename'First .. Last loop
if Filename (Index) = '.' then
Debug_Output ("Invalid name, contains dot");
Debug_Output ("invalid name, contains dot");
return;
end if;
end loop;
@ -6385,7 +6385,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Debug_Output
("Setting full path for "
("setting full path for "
& Get_Name_String (Source.File)
& " at" & Source.Index'Img
& " to "
@ -6551,11 +6551,11 @@ package body Prj.Nmsc is
Language := Tmp_Lang;
Debug_Output
("Implementation of language ", Display_Language_Name);
("implementation of language ", Display_Language_Name);
elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
Debug_Output
("Header of language ", Display_Language_Name);
("header of language ", Display_Language_Name);
if Header_File then
Alternate_Languages := new Language_List_Element'
@ -6585,7 +6585,7 @@ package body Prj.Nmsc is
while Tmp_Lang /= No_Language_Index loop
if Current_Verbosity = High then
Debug_Output
("Testing language "
("testing language "
& Get_Name_String (Tmp_Lang.Name)
& " Header_File=" & Header_File'Img);
end if;
@ -6656,7 +6656,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High
and then Source.File /= No_File
then
Debug_Output ("Override kind for "
Debug_Output ("override kind for "
& Get_Name_String (Source.File)
& " idx=" & Source.Index'Img
& " kind=" & Source.Kind'Img);
@ -6698,7 +6698,7 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Debug_Increase_Indent
("Checking file (rank=" & Source_Dir_Rank'Img & ")",
("checking file (rank=" & Source_Dir_Rank'Img & ")",
Name_Id (Display_Path));
end if;
@ -6928,7 +6928,7 @@ package body Prj.Nmsc is
Success : Boolean := False;
begin
Debug_Output ("Looking for subdirs of ", Name_Id (Path.Display_Name));
Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
if Recursive_Dirs.Get (Visited, Path.Name) then
return Success;
@ -7121,7 +7121,7 @@ package body Prj.Nmsc is
end if;
end if;
Debug_Decrease_Indent ("Done Find_Pattern");
Debug_Decrease_Indent ("done Find_Pattern");
end Find_Pattern;
-- Local variables
@ -7165,7 +7165,7 @@ package body Prj.Nmsc is
Display_File_Name : File_Name_Type;
begin
Debug_Increase_Indent ("Looking for sources of", Project.Project.Name);
Debug_Increase_Indent ("looking for sources of", Project.Project.Name);
-- Loop through subdirectories
@ -7271,7 +7271,7 @@ package body Prj.Nmsc is
(Project.Excluded, File_Name, FF);
Debug_Output
("Excluded source ",
("excluded source ",
Name_Id (Display_File_Name));
-- Will mark the file as removed, but we
@ -7306,7 +7306,7 @@ package body Prj.Nmsc is
else
if Current_Verbosity = High then
Debug_Output ("Ignore " & Name (1 .. Last));
Debug_Output ("ignore " & Name (1 .. Last));
end if;
end if;
end loop;
@ -7325,7 +7325,7 @@ package body Prj.Nmsc is
Src_Dir_Rank := Num_Nod.Next;
end loop;
Debug_Decrease_Indent ("end Looking for sources.");
Debug_Decrease_Indent ("end looking for sources.");
end Search_Directories;
----------------------------
@ -7358,7 +7358,7 @@ package body Prj.Nmsc is
end if;
Debug_Output
("Naming exception: adding source file to source_Names: ",
("naming exception: adding source file to source_Names: ",
Name_Id (Source.File));
Source_Names_Htable.Set
@ -7547,7 +7547,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Debug_Indent;
Write_Str ("Removing file ");
Write_Str ("removing file ");
Write_Line
(Get_Name_String (Excluded.File)
& " " & Get_Name_String (Source.Project.Name));
@ -7819,7 +7819,7 @@ package body Prj.Nmsc is
The_Directory : constant String := Get_Name_String (Directory);
begin
Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
Get_Name_String (File_Name);
Result :=
@ -7853,7 +7853,7 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Debug_Indent;
Write_Str ("Removing source ");
Write_Str ("removing source ");
Write_Str (Get_Name_String (Id.File));
if Id.Index /= 0 then
@ -7957,7 +7957,7 @@ package body Prj.Nmsc is
begin
if Project.Source_Dirs = Nil_String then
Debug_Output ("No source dirs");
Debug_Output ("no Source_Dirs");
else
Debug_Increase_Indent ("Source_Dirs:");
@ -8006,7 +8006,7 @@ package body Prj.Nmsc is
Prj.Nmsc.Check (Project, Data);
if Current_Verbosity = High then
Debug_Decrease_Indent ("Done Processing_Naming_Scheme");
Debug_Decrease_Indent ("done Processing_Naming_Scheme");
end if;
end Recursive_Check;

18
gcc/ada/s-tasren.adb
View File

@ -1101,17 +1101,17 @@ package body System.Tasking.Rendezvous is
-- We rely that the call is off-queue for protection, that the caller
-- will not exit the Entry_Caller_Sleep, and so will not reuse the call
-- record for another call.
-- We rely on the Caller's lock for call State mod's.
-- record for another call. We rely on the Caller's lock for call State
-- mod's.
-- If Acceptor.Terminate_Alternative is True, we need to lock Parent and
-- Acceptor, in that order; otherwise, we only need a lock on
-- Acceptor. However, we can't check Acceptor.Terminate_Alternative
-- until Acceptor is locked. Therefore, we need to lock both. Attempts
-- to avoid locking Parent tend to result in race conditions. It would
-- work to unlock Parent immediately upon finding
-- Acceptor.Terminate_Alternative to be False, but that violates the
-- rule of properly nested locking (see System.Tasking).
-- Acceptor, in that order; otherwise, we only need a lock on Acceptor.
-- However, we can't check Acceptor.Terminate_Alternative until Acceptor
-- is locked. Therefore, we need to lock both. Attempts to avoid locking
-- Parent tend to result in race conditions. It would work to unlock
-- Parent immediately upon finding Acceptor.Terminate_Alternative to be
-- False, but that violates the rule of properly nested locking (see
-- System.Tasking).
STPO.Write_Lock (Parent);
STPO.Write_Lock (Acceptor);

5
gcc/ada/sem_ch12.adb
View File

@ -6919,6 +6919,7 @@ package body Sem_Ch12 is
-- simplified. ???
Inst := Package_Instantiation (A);
if Present (Inst) then
if Nkind (Inst) = N_Package_Instantiation then
return Inst;
@ -7138,8 +7139,8 @@ package body Sem_Ch12 is
-- that we produce all the instance bodies we will need.
if (Is_Entity_Name (Nam) and then Chars (Nam) = Chars (E))
or else (Nkind (Nam) = N_Selected_Component
and then Chars (Selector_Name (Nam)) = Chars (E))
or else (Nkind (Nam) = N_Selected_Component
and then Chars (Selector_Name (Nam)) = Chars (E))
then
return True;
end if;

1
gcc/ada/sem_res.adb
View File

@ -7248,6 +7248,7 @@ package body Sem_Res is
declare
Left_Typ : constant Node_Id := Etype (Left_Opnd (N));
Right_Typ : constant Node_Id := Etype (Right_Opnd (N));
begin
-- Protect call to Matching_Static_Array_Bounds to avoid costly
-- operation if not needed.