From 2598ee6d90f1472899438cc29d6ebb6e45dea578 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 4 Aug 2011 10:22:27 +0000 Subject: [PATCH] bindgen.adb, [...]: Minor reformatting 2011-08-04 Robert Dewar * 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 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/bindgen.adb | 19 +++- gcc/ada/einfo.adb | 5 +- gcc/ada/gcc-interface/Make-lang.in | 13 +-- gcc/ada/makeutl.adb | 154 +++++++++++++++++------------ gcc/ada/opt.ads | 2 +- gcc/ada/prj-env.adb | 2 +- gcc/ada/prj-nmsc.adb | 98 +++++++++--------- gcc/ada/s-tasren.adb | 18 ++-- gcc/ada/sem_ch12.adb | 5 +- gcc/ada/sem_res.adb | 1 + 11 files changed, 184 insertions(+), 139 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cd5c59cbf1a..5415435b92b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2011-08-04 Robert Dewar + + * 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 * prj-env.adb: Remove local debug traces. diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index f13667e242d..893ff131a68 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -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 diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 1dc4658afd3..54f7c87acdb 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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 ----------------------- diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 1f119ee6fcc..d7af952dffa 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -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 \ diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 8e9bd218436..319f0f9ce43 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -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; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e611c047301..0eb44ec7aab 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -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...). diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 0aa907ad1fd..100e178305b 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -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; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 743b2b6edbf..e5bc2b3196b 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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; diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index aed3ec50445..8c604c90a79 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -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); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f0bc8e017de..7de09670fb6 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f91eea49fb9..bd7eaa22ccc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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. -- 2.30.2