[multiple changes]

2014-08-01  Tristan Gingold  <gingold@adacore.com>

	* sem_ch9.adb (Analyze_Task_Type_Declaration): Move code from ...
	* exp_ch9.adb (Make_Task_Create_Call): ... here.

2014-08-01  Vincent Celier  <celier@adacore.com>

	* gnat1drv.adb: Do not try to get the target parameters when
	invoked with -gnats.

2014-08-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Find_Last_Init): Nothing to do for an object
	declaration subject to No_Initialization.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Array_Aggregate): Reject choice that
	is a subtype with dynamic predicates, or a non-static subtype
	with predicates.
	* sem_ch3.adb (Analyze_Number_Declaration): Reject qualified
	expression if subtype has a dynamic predicate.
	(Constrain_Index): Reject subtype indication if subtype mark
	has predicates.
	(Inerit_Predicate_Flags): Inherit Has_Predicates as well.
	(Make_Index): If index is a subtype indication, itype inhereits
	predicate flags for subsequent testing.
	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): New
	procedure Check_Predicate_Use, to reject illegal uses of domains
	of iteration that have dynamic predicates.
	* sem_res.adb (Resolve_Slice): Reject slices given by a subtype
	indication to which a predicate applies.
	* sem_util.adb (Bad_Predicated_Subtype_Use): Add guard to
	prevent cascaded errors when subtype is invalid.

From-SVN: r213450

10 files changed, 187 insertions, 66 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 54b32b4..f39e478 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,38 @@
+2014-08-01  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_ch9.adb (Analyze_Task_Type_Declaration): Move code from ...
+	* exp_ch9.adb (Make_Task_Create_Call): ... here.
+
+2014-08-01  Vincent Celier  <celier@adacore.com>
+
+	* gnat1drv.adb: Do not try to get the target parameters when
+	invoked with -gnats.
+
+2014-08-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Find_Last_Init): Nothing to do for an object
+	declaration subject to No_Initialization.
+
+2014-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Resolve_Array_Aggregate): Reject choice that
+	is a subtype with dynamic predicates, or a non-static subtype
+	with predicates.
+	* sem_ch3.adb (Analyze_Number_Declaration): Reject qualified
+	expression if subtype has a dynamic predicate.
+	(Constrain_Index): Reject subtype indication if subtype mark
+	has predicates.
+	(Inerit_Predicate_Flags): Inherit Has_Predicates as well.
+	(Make_Index): If index is a subtype indication, itype inhereits
+	predicate flags for subsequent testing.
+	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): New
+	procedure Check_Predicate_Use, to reject illegal uses of domains
+	of iteration that have dynamic predicates.
+	* sem_res.adb (Resolve_Slice): Reject slices given by a subtype
+	indication to which a predicate applies.
+	* sem_util.adb (Bad_Predicated_Subtype_Use): Add guard to
+	prevent cascaded errors when subtype is invalid.
+
 2014-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch10.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 7d1526c..e295180 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2449,6 +2449,15 @@ package body Exp_Ch7 is
                   Next (Stmt);
                end loop;
 
+            --  Nothing to do for an object with supporessed initialization.
+            --  Note that this check is not performed at the beginning of the
+            --  routine because a declaration marked with No_Initialization
+            --  may still be initialized by a build-in-place call (the case
+            --  above).
+
+            elsif No_Initialization (Decl) then
+               return;
+
             --  In all other cases the initialization calls follow the related
             --  object. The general structure of object initialization built by
             --  routine Default_Initialize_Object is as follows:
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 3cacc77..d01e849 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -14013,20 +14013,6 @@ package body Exp_Ch9 is
       Ttyp := Corresponding_Concurrent_Type (Task_Rec);
       Tnam := Chars (Ttyp);
 
-      --  The sequential partition elaboration policy is supported only in the
-      --  restricted profile.
-
-      --  This test should be in sem_ch9, not here ???
-
-      if Partition_Elaboration_Policy = 'S'
-        and then not Restricted_Profile
-      then
-         Error_Msg_N
-           ("sequential elaboration supported only in restricted profile",
-            Task_Rec);
-         return Make_Null_Statement (Loc);
-      end if;
-
       --  Get task declaration. In the case of a task type declaration, this is
       --  simply the parent of the task type entity. In the single task
       --  declaration, this parent will be the implicit type, and we can find
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 6e6b5c5..536c321 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -863,53 +863,65 @@ begin
 
       Opt.Compilation_Time := System.OS_Lib.Current_Time_String;
 
-      --  Acquire target parameters from system.ads (source of package System)
+      --  Get the target parameters only when -gnats is not used, to avoid
+      --  failing when there is no default runtime.
 
-      Targparm_Acquire : declare
-         use Sinput;
+      if Operating_Mode /= Check_Syntax then
 
-         S : Source_File_Index;
-         N : File_Name_Type;
+         --  Acquire target parameters from system.ads (package System source)
+         --  System).
 
-      begin
-         Name_Buffer (1 .. 10) := "system.ads";
-         Name_Len := 10;
-         N := Name_Find;
-         S := Load_Source_File (N);
+         Targparm_Acquire : declare
+            use Sinput;
 
-         if S = No_Source_File then
-            Write_Line
-              ("fatal error, run-time library not installed correctly");
-            Write_Line ("cannot locate file system.ads");
-            raise Unrecoverable_Error;
+            S : Source_File_Index;
+            N : File_Name_Type;
 
-         --  Remember source index of system.ads (which was read successfully)
+         begin
+            Name_Buffer (1 .. 10) := "system.ads";
+            Name_Len := 10;
+            N := Name_Find;
+            S := Load_Source_File (N);
 
-         else
-            System_Source_File_Index := S;
-         end if;
+            --  Failed to read system.ads, fatal error
 
-         Targparm.Get_Target_Parameters
-           (System_Text  => Source_Text  (S),
-            Source_First => Source_First (S),
-            Source_Last  => Source_Last  (S),
-            Make_Id      => Tbuild.Make_Id'Access,
-            Make_SC      => Tbuild.Make_SC'Access,
-            Set_RND      => Tbuild.Set_RND'Access);
+            if S = No_Source_File then
+               Write_Line
+                 ("fatal error, run-time library not installed correctly");
+               Write_Line ("cannot locate file system.ads");
+               raise Unrecoverable_Error;
 
-         --  Acquire configuration pragma information from Targparm
+            --  Read system.ads successfully, remember its source index
+
+            else
+               System_Source_File_Index := S;
+            end if;
 
-         Restrict.Restrictions := Targparm.Restrictions_On_Target;
-      end Targparm_Acquire;
+            Targparm.Get_Target_Parameters
+              (System_Text  => Source_Text  (S),
+               Source_First => Source_First (S),
+               Source_Last  => Source_Last  (S),
+               Make_Id      => Tbuild.Make_Id'Access,
+               Make_SC      => Tbuild.Make_SC'Access,
+               Set_RND      => Tbuild.Set_RND'Access);
+
+            --  Acquire configuration pragma information from Targparm
+
+            Restrict.Restrictions := Targparm.Restrictions_On_Target;
+         end Targparm_Acquire;
+      end if;
 
       --  Perform various adjustments and settings of global switches
 
       Adjust_Global_Switches;
 
       --  Output copyright notice if full list mode unless we have a list
-      --  file, in which case we defer this so that it is output in the file
+      --  file, in which case we defer this so that it is output in the file.
 
       if (Verbose_Mode or else (Full_List and then Full_List_File_Name = null))
+
+        --  Debug flag gnatd7 suppresses this copyright notice
+
         and then not Debug_Flag_7
       then
          Write_Eol;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 3ebaa7f..5cc0f63 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1727,6 +1727,15 @@ package body Sem_Aggr is
                      if Is_Type (E) and then Has_Predicates (E) then
                         Freeze_Before (N, E);
 
+                        if Has_Dynamic_Predicate_Aspect (E) then
+                           Error_Msg_NE ("subtype& has dynamic predicate,"
+                             & "not allowed in aggregate choice", Choice, E);
+
+                        elsif not Is_Static_Subtype (E) then
+                           Error_Msg_NE ("non-static subtype& has predicate,"
+                             & "not allowed in aggregate choice", Choice, E);
+                        end if;
+
                         --  If the subtype has a static predicate, replace the
                         --  original choice with the list of individual values
                         --  covered by the predicate.
@@ -1882,6 +1891,14 @@ package body Sem_Aggr is
                   elsif Nkind (Choice) = N_Subtype_Indication then
                      Resolve_Discrete_Subtype_Indication (Choice, Index_Base);
 
+                     if Has_Dynamic_Predicate_Aspect
+                       (Entity (Subtype_Mark (Choice)))
+                     then
+                        Error_Msg_NE ("subtype& has dynamic predicate, "
+                          & "not allowed in aggregate choice",
+                            Choice, Entity (Subtype_Mark (Choice)));
+                     end if;
+
                      --  Does the subtype indication evaluation raise CE?
 
                      Get_Index_Bounds (Subtype_Mark (Choice), S_Low, S_High);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index df59cb7..560eb03 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2920,6 +2920,11 @@ package body Sem_Ch3 is
 
       if not Is_Overloaded (E) then
          T := Etype (E);
+         if Has_Dynamic_Predicate_Aspect (T) then
+            Error_Msg_N
+              ("subtype has dynamic predicate, "
+                 & "not allowed in number declaration", N);
+         end if;
 
       else
          T := Any_Type;
@@ -12424,6 +12429,10 @@ package body Sem_Ch3 is
          --  The parser has verified that this is a discrete indication
 
          Resolve_Discrete_Subtype_Indication (S, T);
+         Bad_Predicated_Subtype_Use
+           ("subtype& has predicate, not allowed in index constraint",
+            S, Entity (Subtype_Mark (S)));
+
          R := Range_Expression (Constraint (S));
 
          --  Capture values of bounds and generate temporaries for them if
@@ -16802,6 +16811,7 @@ package body Sem_Ch3 is
 
    procedure Inherit_Predicate_Flags (Subt, Par : Entity_Id) is
    begin
+      Set_Has_Predicates (Subt, Has_Predicates (Par));
       Set_Has_Static_Predicate_Aspect
         (Subt, Has_Static_Predicate_Aspect (Par));
       Set_Has_Dynamic_Predicate_Aspect
@@ -17419,6 +17429,10 @@ package body Sem_Ch3 is
          Set_Scalar_Range   (Def_Id, R);
          Conditional_Delay  (Def_Id, T);
 
+         if Nkind (N) = N_Subtype_Indication then
+            Inherit_Predicate_Flags (Def_Id, Entity (Subtype_Mark (N)));
+         end if;
+
          --  In the subtype indication case, if the immediate parent of the
          --  new subtype is non-static, then the subtype we create is non-
          --  static, even if its bounds are static.
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 4bbd42f..37c8646 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2134,6 +2134,12 @@ package body Sem_Ch5 is
       --  to capture the bounds, so that the function result can be finalized
       --  in timely fashion.
 
+      procedure Check_Predicate_Use (T : Entity_Id);
+      --  Diagnose Attempt to iterate through non-static predicate. Note that
+      --  a type with inherited predicates may have both static and dynamic
+      --  forms. In this case it is not sufficent to check the static predicate
+      --  function only, look for a dynamic predicate aspect as well.
+
       function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean;
       --  N is the node for an arbitrary construct. This function searches the
       --  construct N to see if any expressions within it contain function
@@ -2192,6 +2198,27 @@ package body Sem_Ch5 is
          end if;
       end Check_Controlled_Array_Attribute;
 
+      -------------------------
+      -- Check_Predicate_Use --
+      -------------------------
+
+      procedure Check_Predicate_Use (T : Entity_Id) is
+      begin
+         if Is_Discrete_Type (T)
+           and then Has_Predicates (T)
+           and then (not Has_Static_Predicate (T)
+                      or else Has_Dynamic_Predicate_Aspect (T))
+         then
+            Bad_Predicated_Subtype_Use
+              ("cannot use subtype& with non-static predicate for loop " &
+               "iteration", Discrete_Subtype_Definition (N),
+                  T, Suggest_Static => True);
+
+         elsif Inside_A_Generic and then Is_Generic_Formal (T) then
+            Set_No_Dynamic_Predicate_On_Actual (T);
+         end if;
+      end Check_Predicate_Use;
+
       ------------------------------------
       -- Has_Call_Using_Secondary_Stack --
       ------------------------------------
@@ -2566,23 +2593,7 @@ package body Sem_Ch5 is
             Set_Etype  (DS, Entity (DS));
          end if;
 
-         --  Attempt to iterate through non-static predicate. Note that a type
-         --  with inherited predicates may have both static and dynamic forms.
-         --  In this case it is not sufficent to check the static predicate
-         --  function only, look for a dynamic predicate aspect as well.
-
-         if Is_Discrete_Type (Entity (DS))
-           and then Has_Predicates (Entity (DS))
-           and then (not Has_Static_Predicate (Entity (DS))
-                      or else Has_Dynamic_Predicate_Aspect (Entity (DS)))
-         then
-            Bad_Predicated_Subtype_Use
-              ("cannot use subtype& with non-static predicate for loop " &
-               "iteration", DS, Entity (DS), Suggest_Static => True);
-
-         elsif Inside_A_Generic and then Is_Generic_Formal (Entity (DS)) then
-            Set_No_Dynamic_Predicate_On_Actual (Entity (DS));
-         end if;
+         Check_Predicate_Use (Entity (DS));
       end if;
 
       --  Error if not discrete type
@@ -2594,6 +2605,10 @@ package body Sem_Ch5 is
 
       Check_Controlled_Array_Attribute (DS);
 
+      if Nkind (DS) = N_Subtype_Indication then
+         Check_Predicate_Use (Entity (Subtype_Mark (DS)));
+      end if;
+
       Make_Index (DS, N, In_Iter_Schm => True);
       Set_Ekind (Id, E_Loop_Parameter);
 
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 82fa38a..7a49d4b 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -2896,6 +2896,17 @@ package body Sem_Ch9 is
    begin
       Check_Restriction (No_Tasking, N);
       Tasking_Used := True;
+
+      --  The sequential partition elaboration policy is supported only in the
+      --  restricted profile.
+
+      if Partition_Elaboration_Policy = 'S'
+        and then not Restricted_Profile
+      then
+         Error_Msg_N
+           ("sequential elaboration supported only in restricted profile", N);
+      end if;
+
       T := Find_Type_Name (N);
       Generate_Definition (T);
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 38c1017..c0d3638 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9814,14 +9814,28 @@ package body Sem_Res is
 
       --  Check bad use of type with predicates
 
-      if Has_Predicates (Etype (Drange)) then
-         Bad_Predicated_Subtype_Use
-           ("subtype& has predicate, not allowed in slice",
-            Drange, Etype (Drange));
+      declare
+         Subt : Entity_Id;
+
+      begin
+         if Nkind (Drange) = N_Subtype_Indication
+            and then Has_Predicates (Entity (Subtype_Mark (Drange)))
+         then
+            Subt := Entity (Subtype_Mark (Drange));
+
+         else
+            Subt := Etype (Drange);
+         end if;
+
+         if Has_Predicates (Subt) then
+            Bad_Predicated_Subtype_Use
+              ("subtype& has predicate, not allowed in slice", Drange, Subt);
+         end if;
+      end;
 
       --  Otherwise here is where we check suspicious indexes
 
-      elsif Nkind (Drange) = N_Range then
+      if Nkind (Drange) = N_Range then
          Warn_On_Suspicious_Index (Name, Low_Bound  (Drange));
          Warn_On_Suspicious_Index (Name, High_Bound (Drange));
       end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 44435ca..23c5fa7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -782,7 +782,15 @@ package body Sem_Util is
       Suggest_Static : Boolean := False)
    is
       Gen            : Entity_Id;
+
    begin
+
+      --  Avoid cascaded errors
+
+      if Error_Posted (N) then
+         return;
+      end if;
+
       if Inside_A_Generic then
          Gen := Current_Scope;
          while Present (Gen) and then  Ekind (Gen) /= E_Generic_Package loop