From 43c58950be209f57279c16f4663437956eb5a593 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 17 Oct 2014 11:20:50 +0200 Subject: [PATCH] [multiple changes] 2014-10-17 Robert Dewar * exp_ch9.adb (Expand_N_Task_Body): Add defense against previous errors. * freeze.adb (Freeze_Entity): Add defense against checking null scope for generic. * restrict.adb (Tasking_Allowed): Add test for No_Run_Time mode. * sem_ch13.adb (Freeze_Entity_Checks): Add defense against previous errors. * sem_ch9.adb (Analyze_Task_Type_Declaration): Give error if in No_Run_Time mode. 2014-10-17 Robert Dewar * prj-makr.adb: Minor reformatting. 2014-10-17 Robert Dewar * gnatcmd.adb, make.adb, prj-part.adb, gnatlink.adb, prj-nmsc.adb, prj-conf.adb, prj-env.adb: Use Is_Directory_Separator where possible. 2014-10-17 Ed Schonberg * exp_prag.adb (Undo_Initialization): If Initialize_Scalars is enabled, code will be generated for some composite types to initialize an object after its declaration. If there is a subsequent Import pragma for the object, that code must be removed as specified byw the semantics of the pragma, and to prevent out-of-order elaboration issues in the back-end. 2014-10-17 Hristian Kirtchev * exp_ch4.adb (Expand_N_Op_Concat): Keep concatenation operator wrapping mechanism under debug flag -gnatd.h. * debug.adb: Claim debug switch -gnatd.h. From-SVN: r216384 --- gcc/ada/ChangeLog | 36 ++++++++++++++++++++++++++++++++++ gcc/ada/debug.adb | 7 ++++++- gcc/ada/exp_ch4.adb | 35 ++++++++++++++++++++++++++++++++- gcc/ada/exp_ch9.adb | 7 +++++++ gcc/ada/exp_prag.adb | 21 ++++++++++++++++++++ gcc/ada/freeze.adb | 3 ++- gcc/ada/gnatcmd.adb | 11 ++++------- gcc/ada/gnatlink.adb | 5 ++--- gcc/ada/make.adb | 6 ++---- gcc/ada/prj-conf.adb | 6 ++++-- gcc/ada/prj-env.adb | 13 ++++++------- gcc/ada/prj-makr.adb | 11 +++++------ gcc/ada/prj-nmsc.adb | 46 ++++++++++++++++---------------------------- gcc/ada/prj-part.adb | 3 +-- gcc/ada/restrict.adb | 3 ++- gcc/ada/sem_ch13.adb | 3 ++- gcc/ada/sem_ch9.adb | 15 ++++++++++++++- 17 files changed, 165 insertions(+), 66 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ba51cc3a931..70bad2fd58a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2014-10-17 Robert Dewar + + * exp_ch9.adb (Expand_N_Task_Body): Add defense against + previous errors. + * freeze.adb (Freeze_Entity): Add defense against checking null + scope for generic. + * restrict.adb (Tasking_Allowed): Add test for No_Run_Time mode. + * sem_ch13.adb (Freeze_Entity_Checks): Add defense against + previous errors. + * sem_ch9.adb (Analyze_Task_Type_Declaration): Give error if + in No_Run_Time mode. + +2014-10-17 Robert Dewar + + * prj-makr.adb: Minor reformatting. + +2014-10-17 Robert Dewar + + * gnatcmd.adb, make.adb, prj-part.adb, gnatlink.adb, prj-nmsc.adb, + prj-conf.adb, prj-env.adb: Use Is_Directory_Separator where possible. + +2014-10-17 Ed Schonberg + + * exp_prag.adb (Undo_Initialization): If Initialize_Scalars + is enabled, code will be generated for some composite types + to initialize an object after its declaration. If there is + a subsequent Import pragma for the object, that code must be + removed as specified byw the semantics of the pragma, and to + prevent out-of-order elaboration issues in the back-end. + +2014-10-17 Hristian Kirtchev + + * exp_ch4.adb (Expand_N_Op_Concat): Keep concatenation operator + wrapping mechanism under debug flag -gnatd.h. + * debug.adb: Claim debug switch -gnatd.h. + 2014-10-17 Doug Rupp * gcc-interface/Makefile.in: Enable the socket runtime bits diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 94da7a6180e..2b249e926e0 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -98,7 +98,7 @@ package body Debug is -- d.e Enable atomic synchronization -- d.f Inhibit folding of static expressions -- d.g Enable conversion of raise into goto - -- d.h + -- d.h Minimize the creation of public internal symbols for concatenation -- d.i Ignore Warnings pragmas -- d.j Generate listing of frontend inlined calls -- d.k @@ -525,6 +525,11 @@ package body Debug is -- this if this debug flag is set. Later we will enable this more -- generally by default. + -- d.h Minimize the creation of public internal symbols for concatenation + -- by enforcing a secondary stack-like handling of the final result. + -- The target of the concatenation is thus constrained in place and + -- initialized with the result instead of acting as its alias. + -- d.i Ignore all occurrences of pragma Warnings in the sources. This can -- be used in particular to disable Warnings (Off) to check if any of -- these statements are inappropriate. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 5fdba539c28..eeada2c8ff1 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6589,7 +6589,40 @@ package body Exp_Ch4 is Append (Right_Opnd (Cnode), Opnds); end loop Inner; - Expand_Concatenate (Cnode, Opnds); + -- Note: The following code is a temporary workaround for N731-034 + -- and N829-028 and will be kept until the general issue of internal + -- symbol serialization is addressed. The workaround is kept under a + -- debug switch to avoid permiating into the general case. + + -- Wrap the node to concatenate into an expression actions node to + -- keep it nicely packaged. This is useful in the case of an assert + -- pragma with a concatenation where we want to be able to delete + -- the concatenation and all its expansion stuff. + + if Debug_Flag_Dot_H then + declare + Cnod : constant Node_Id := Relocate_Node (Cnode); + Typ : constant Entity_Id := Base_Type (Etype (Cnode)); + + begin + -- Note: use Rewrite rather than Replace here, so that for + -- example Why_Not_Static can find the original concatenation + -- node OK! + + Rewrite (Cnode, + Make_Expression_With_Actions (Sloc (Cnode), + Actions => New_List (Make_Null_Statement (Sloc (Cnode))), + Expression => Cnod)); + + Expand_Concatenate (Cnod, Opnds); + Analyze_And_Resolve (Cnode, Typ); + end; + + -- Default case + + else + Expand_Concatenate (Cnode, Opnds); + end if; exit Outer when Cnode = N; Cnode := Parent (Cnode); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index aff566ded28..9682859feea 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11449,6 +11449,13 @@ package body Exp_Ch9 is -- Used to determine the proper location of wrapper body insertions begin + -- if no task body procedure, means we had an error in configurable + -- run-time mode, and there is no point in proceeding further. + + if No (Task_Body_Procedure (Ttyp)) then + return; + end if; + -- Add renaming declarations for discriminals and a declaration for the -- entry family index (if applicable). diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f48db6f605f..6ceaf310b06 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -1863,6 +1863,27 @@ package body Exp_Prag is if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then Set_Expression (Parent (Def_Id), Empty); end if; + + -- The object may not have any initialization, but in the presence of + -- Initialize_Scalars code is inserted after then declaration, which + -- must now be removed as well. The code carries the same source + -- location as the declaration itself. + + if Initialize_Scalars and then Is_Array_Type (Etype (Def_Id)) then + declare + Init : Node_Id; + Nxt : Node_Id; + begin + Init := Next (Parent (Def_Id)); + while not Comes_From_Source (Init) + and then Sloc (Init) = Sloc (Def_Id) + loop + Nxt := Next (Init); + Remove (Init); + Init := Nxt; + end loop; + end; + end if; end Undo_Initialization; end Exp_Prag; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 2eea620a979..5b4bfd9b5d7 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -5024,7 +5024,8 @@ package body Freeze is -- that later when the full type is frozen). elsif Ekind_In (E, E_Record_Type, E_Record_Subtype) - and then not Is_Generic_Unit (Scope (E)) + and then not (Present (Scope (E)) + and then Is_Generic_Unit (Scope (E))) then Freeze_Record_Type (E); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 77cf6dc47ae..c7a1330a151 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -883,10 +883,9 @@ procedure GNATCmd is if not Is_Absolute_Path (Exec_File_Name) then for Index in Exec_File_Name'Range loop if Exec_File_Name (Index) = Directory_Separator then - Fail ("relative executable (""" & - Exec_File_Name & - """) with directory part not allowed " & - "when using project files"); + Fail ("relative executable (""" & Exec_File_Name + & """) with directory part not allowed " + & "when using project files"); end if; end loop; @@ -1398,9 +1397,7 @@ procedure GNATCmd is else for K in Switch'Range loop - if Switch (K) = '/' - or else Switch (K) = Directory_Separator - then + if Is_Directory_Separator (Switch (K)) then Test_Existence := True; exit; end if; diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 6c93c0ba62e..190aadfb206 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1204,9 +1204,8 @@ procedure Gnatlink is if GCC_Index = 0 then GCC_Index := Index (Path (1 .. Path_Last), - Directory_Separator & - "lib" & - Directory_Separator); + Directory_Separator & "lib" + & Directory_Separator); end if; -- If we have found a "lib" subdir in diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 07f960bddeb..eb062e38ce9 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4057,8 +4057,7 @@ package body Make is begin First := Name'Last; while First > Name'First - and then Name (First - 1) /= Directory_Separator - and then Name (First - 1) /= '/' + and then not Is_Directory_Separator (Name (First - 1)) loop First := First - 1; end loop; @@ -6805,8 +6804,7 @@ package body Make is begin First := Name'Last; while First > Name'First - and then Name (First - 1) /= Directory_Separator - and then Name (First - 1) /= '/' + and then not Is_Directory_Separator (Name (First - 1)) loop First := First - 1; end loop; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 56d116ec75b..6d5cdc7cc15 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -26,6 +26,7 @@ with Makeutl; use Makeutl; with MLib.Tgt; with Opt; use Opt; +with Osint; use Osint; with Output; use Output; with Prj.Env; with Prj.Err; @@ -1526,11 +1527,12 @@ package body Prj.Conf is function Is_Base_Name (Path : String) return Boolean is begin - for I in Path'Range loop - if Path (I) = Directory_Separator or else Path (I) = '/' then + for J in Path'Range loop + if Is_Directory_Separator (Path (J)) then return False; end if; end loop; + return True; end Is_Base_Name; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 30f2b993e03..9dcd3249e1e 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1435,7 +1435,7 @@ package body Prj.Env is function Is_Base_Name (Path : String) return Boolean is begin for J in Path'Range loop - if Path (J) = Directory_Separator or else Path (J) = '/' then + if Is_Directory_Separator (Path (J)) then return False; end if; end loop; @@ -2131,14 +2131,14 @@ package body Prj.Env is -- $prefix/share/gpr Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "share" & Directory_Separator & "gpr"); + (Path_Separator & Prefix.all & "share" + & Directory_Separator & "gpr"); -- $prefix/lib/gnat Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "lib" & Directory_Separator & "gnat"); + (Path_Separator & Prefix.all & "lib" + & Directory_Separator & "gnat"); end if; Free (Prefix); @@ -2293,8 +2293,7 @@ package body Prj.Env is exit Check_Dot; end if; - exit Check_Dot when File (K) = Directory_Separator - or else File (K) = '/'; + exit Check_Dot when Is_Directory_Separator (File (K)); end loop Check_Dot; if not Is_Absolute_Path (File) then diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index d58f4df9a1d..06cb64b32e8 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -1187,7 +1187,7 @@ package body Prj.Makr is Canonical_Case_File_Name (Canon (1 .. Last)); if Is_Regular_File - (Dir_Name & Directory_Separator & Str (1 .. Last)) + (Dir_Name & Directory_Separator & Str (1 .. Last)) then Matched := True; @@ -1277,10 +1277,9 @@ package body Prj.Makr is new String'(Get_Name_String (Tmp_File)); end if; - Args (Args'Last) := new String' - (Dir_Name & - Directory_Separator & - Str (1 .. Last)); + Args (Args'Last) := + new String' + (Dir_Name & Directory_Separator & Str (1 .. Last)); -- Save the standard output and error @@ -1477,7 +1476,7 @@ package body Prj.Makr is -- Do not call itself for "." or ".." if Is_Directory - (Dir_Name & Directory_Separator & Str (1 .. Last)) + (Dir_Name & Directory_Separator & Str (1 .. Last)) and then Str (1 .. Last) /= "." and then Str (1 .. Last) /= ".." then diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 5d3d6290799..24007995df1 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5031,10 +5031,7 @@ package body Prj.Nmsc is if OK then for J in 1 .. Name_Len loop - if Name_Buffer (J) = '/' - or else - Name_Buffer (J) = Directory_Separator - then + if Is_Directory_Separator (Name_Buffer (J)) then OK := False; exit; end if; @@ -5336,9 +5333,7 @@ package body Prj.Nmsc is function Compute_Directory_Last (Dir : String) return Natural is begin if Dir'Length > 1 - and then (Dir (Dir'Last - 1) = Directory_Separator - or else - Dir (Dir'Last - 1) = '/') + and then Is_Directory_Separator (Dir (Dir'Last - 1)) then return Dir'Last - 1; else @@ -5858,7 +5853,7 @@ package body Prj.Nmsc is -- Check that there is no directory information for J in 1 .. Last loop - if Line (J) = '/' or else Line (J) = Directory_Separator then + if Is_Directory_Separator (Line (J)) then Error_Msg_File_1 := Source_Name; Error_Msg (Data.Flags, @@ -6485,15 +6480,12 @@ package body Prj.Nmsc is -- Check that there is no directory information for J in 1 .. Last loop - if Line (J) = '/' - or else - Line (J) = Directory_Separator - then + if Is_Directory_Separator (Line (J)) then Error_Msg_File_1 := Name; Error_Msg (Data.Flags, - "file name cannot include " & - "directory information ({)", + "file name cannot include " + & "directory information ({)", Location, Project.Project); exit; end if; @@ -6600,10 +6592,7 @@ package body Prj.Nmsc is -- Check that there is no directory information for J in 1 .. Name_Len loop - if Name_Buffer (J) = '/' - or else - Name_Buffer (J) = Directory_Separator - then + if Is_Directory_Separator (Name_Buffer (J)) then Error_Msg_File_1 := Name; Error_Msg (Data.Flags, @@ -7394,11 +7383,11 @@ package body Prj.Nmsc is if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then declare Path_Name : constant String := - Normalize_Pathname - (Name => Name (1 .. Last), - Directory => Path_Str, - Resolve_Links => Resolve_Links) - & Directory_Separator; + Normalize_Pathname + (Name => Name (1 .. Last), + Directory => Path_Str, + Resolve_Links => Resolve_Links) + & Directory_Separator; Path2 : Path_Information; OK : Boolean := True; @@ -7475,8 +7464,7 @@ package body Prj.Nmsc is if Search_For = Search_Files then while Pattern_End >= Pattern'First - and then Pattern (Pattern_End) /= '/' - and then Pattern (Pattern_End) /= Directory_Separator + and then not Is_Directory_Separator (Pattern (Pattern_End)) loop Pattern_End := Pattern_End - 1; end loop; @@ -7512,9 +7500,9 @@ package body Prj.Nmsc is Recursive := Pattern_End - 1 >= Pattern'First and then Pattern (Pattern_End - 1 .. Pattern_End) = "**" - and then (Pattern_End - 1 = Pattern'First - or else Pattern (Pattern_End - 2) = '/' - or else Pattern (Pattern_End - 2) = Directory_Separator); + and then + (Pattern_End - 1 = Pattern'First + or else Is_Directory_Separator (Pattern (Pattern_End - 2))); if Recursive then Pattern_End := Pattern_End - 2; @@ -7631,7 +7619,7 @@ package body Prj.Nmsc is declare Source_Directory : constant String := Get_Name_String (Element.Value) - & Directory_Separator; + & Directory_Separator; Dir_Last : constant Natural := Compute_Directory_Last (Source_Directory); diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index bc6a566e2ca..5f04158bebf 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -349,8 +349,7 @@ package body Prj.Part is Get_Name_String (Path_Name_Of (Main_Project, In_Tree)); while Name_Len > 0 - and then Name_Buffer (Name_Len) /= Directory_Separator - and then Name_Buffer (Name_Len) /= '/' + and then not Is_Directory_Separator (Name_Buffer (Name_Len)) loop Name_Len := Name_Len - 1; end loop; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index f2e6a1f9e5e..13732fb73a3 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -1533,7 +1533,8 @@ package body Restrict is begin return not Restrictions.Set (No_Tasking) and then (not Restrictions.Set (Max_Tasks) - or else Restrictions.Value (Max_Tasks) > 0); + or else Restrictions.Value (Max_Tasks) > 0) + and then not No_Run_Time_Mode; end Tasking_Allowed; end Restrict; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9ab019a0648..c8cfd031b36 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10304,7 +10304,8 @@ package body Sem_Ch13 is -- Check Ada derivation of CPP type - if Expander_Active -- why? losing errors in -gnatc mode??? + if Expander_Active -- why? losing errors in -gnatc mode??? + and then Present (Etype (E)) -- defend against errors and then Tagged_Type_Expansion and then Ekind (E) = E_Record_Type and then Etype (E) /= E diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 6be4f559a6c..f48c7bd960b 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2894,7 +2894,20 @@ package body Sem_Ch9 is T : Entity_Id; begin - Check_Restriction (No_Tasking, N); + -- Attempt to use tasking in no run time mode is not allowe. Issue hard + -- error message to disable expansion which leads to crashes. + + if Opt.No_Run_Time_Mode then + Error_Msg_N ("tasking not allowed in No_Run_Time mode", N); + + -- Otherwise soft check for no tasking restriction + + else + Check_Restriction (No_Tasking, N); + end if; + + -- Proceed ahead with analysis of task type declaration + Tasking_Used := True; -- The sequential partition elaboration policy is supported only in the -- 2.30.2