[multiple changes]

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* 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  <dewar@adacore.com>

	* prj-makr.adb: Minor reformatting.

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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

@@ -1,3 +1,39 @@
+2014-10-17  Robert Dewar  <dewar@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
+	* prj-makr.adb: Minor reformatting.
+
+2014-10-17  Robert Dewar  <dewar@adacore.com>
+
+	* 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  <schonberg@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
+
+	* 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  <rupp@adacore.com>
 
 	* gcc-interface/Makefile.in: Enable the socket runtime bits

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.

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);

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).
 

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;

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);
 

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;

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

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;

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;
 

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

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

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);

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;

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;

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

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