[multiple changes]

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

	* inline.adb, einfo.ads, s-tassta.adb, s-tarest.adb: Minor comment
	fixes.

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

	* sem_prag.adb (Process_Import_Or_Interface): Handle properly
	an aspect Import that specifies a False value.

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

	* gnat_rm.texi: Add section on aspect Invariant'Class.

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

	* sem_case.adb (Check_Choice_Set): New flag Predicate_Error,
	for better control of cascaded error messages when some choice
	in a case statement over a predicated type violates the given
	static predicate.

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

	* sem_ch3.adb (Build_Derived_Type): Modify the
	inheritance of the rep chain to ensure that a non-tagged type's
	items are not clobbered during the inheritance.

From-SVN: r213566

9 files changed, 133 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 26d63fa..d02d068 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,32 @@
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
+	* inline.adb, einfo.ads, s-tassta.adb, s-tarest.adb: Minor comment
+	fixes.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Process_Import_Or_Interface): Handle properly
+	an aspect Import that specifies a False value.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Add section on aspect Invariant'Class.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_case.adb (Check_Choice_Set): New flag Predicate_Error,
+	for better control of cascaded error messages when some choice
+	in a case statement over a predicated type violates the given
+	static predicate.
+
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch3.adb (Build_Derived_Type): Modify the
+	inheritance of the rep chain to ensure that a non-tagged type's
+	items are not clobbered during the inheritance.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch3.adb, einfo.ads: Minor reformatting.
 
 2014-08-04  Yannick Moy  <moy@adacore.com>
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 491e84d..fb737e1 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -5716,7 +5716,7 @@ package Einfo is
    --    Requires_Overriding                 (Flag213)  (non-generic case only)
    --    Return_Present                      (Flag54)
    --    Returns_By_Ref                      (Flag90)
-   --    Returns_Limited_View                (Flag134)
+   --    Returns_Limited_View                (Flag134)  (non-generic case only)
    --    Sec_Stack_Needed_For_Return         (Flag167)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Uses_Sec_Stack                      (Flag95)
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index cf44edb..cd215f5 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -308,6 +308,7 @@ Implementation Defined Aspects
 * Aspect Initializes::
 * Aspect Inline_Always::
 * Aspect Invariant::
+* Aspect Invariant'Class::
 * Aspect Iterable::
 * Aspect Linker_Section::
 * Aspect No_Elaboration_Code_All::
@@ -8061,6 +8062,7 @@ clause.
 * Aspect Initializes::
 * Aspect Inline_Always::
 * Aspect Invariant::
+* Aspect Invariant'Class::
 * Aspect Iterable::
 * Aspect Linker_Section::
 * Aspect Lock_Free::
@@ -8285,6 +8287,14 @@ This aspect is equivalent to pragma @code{Invariant}. It is a
 synonym for the language defined aspect @code{Type_Invariant} except
 that it is separately controllable using pragma @code{Assertion_Policy}.
 
+@node Aspect Invariant'Class
+@unnumberedsec Aspect Invariant'Class
+@findex Invariant'Class
+@noindent
+This aspect is equivalent to pragma @code{Type_Invariant_Class}. It is a
+synonym for the language defined aspect @code{Type_Invariant'Class} except
+that it is separately controllable using pragma @code{Assertion_Policy}.
+
 @node Aspect Iterable
 @unnumberedsec Aspect Iterable
 @findex Iterable
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 022bc76..c2e0f18 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1384,6 +1384,7 @@ package body Inline is
 
       function Is_Unit_Subprogram (Id : Entity_Id) return Boolean;
       --  Returns True if subprogram Id defines a compilation unit
+      --  Shouldn't this be in Sem_Aux???
 
       function In_Package_Visible_Spec (Id : Node_Id) return Boolean;
       --  Returns True if subprogram Id is defined in the visible part of a
diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb
index d8478fa..5d44196 100644
--- a/gcc/ada/s-tarest.adb
+++ b/gcc/ada/s-tarest.adb
@@ -211,6 +211,8 @@ package body System.Tasking.Restricted.Stages is
         (1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
                 SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100);
       for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
+      --  This is the secondary stack data. Note that it is critical that this
+      --  have maximum alignment, since any kind of data can be allocated here.
 
       pragma Warnings (Off);
       Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 971879c..da76c65 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1053,7 +1053,9 @@ package body System.Tasking.Stages is
 
       Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
       for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
-      --  Actual area allocated for secondary stack
+      --  Actual area allocated for secondary stack. Note that it is critical
+      --  that this have maximum alignment, since any kind of data can be
+      --  allocated here.
 
       Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
       --  Address of secondary stack. In the fixed secondary stack case, this
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 1009bb0..b14f047 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -113,7 +113,12 @@ package body Sem_Case is
       Subtyp         : Entity_Id;
       Others_Present : Boolean;
       Case_Node      : Node_Id)
+
    is
+      Predicate_Error : Boolean;
+      --  Flag to prevent cascaded errors when a static predicate is known to
+      --  be violated by one choice.
+
       procedure Check_Against_Predicate
         (Pred    : in out Node_Id;
          Choice  : Choice_Bounds;
@@ -626,6 +631,12 @@ package body Sem_Case is
 
          elsif Value1 > Value2 then
             return;
+
+         --  If predicate is already known to be violated, do no check for
+         --  coverage error, to prevent cascaded messages.
+
+         elsif Predicate_Error then
+            return;
          end if;
 
          --  Case of only one value that is missing
@@ -748,6 +759,8 @@ package body Sem_Case is
       --  expression is static, independently of whether the aspect mentions
       --  Static explicitly.
 
+      Predicate_Error := False;
+
       if Has_Predicate then
          Pred    := First (Static_Discrete_Predicate (Bounds_Type));
          Prev_Lo := Uint_Minus_1;
@@ -763,13 +776,21 @@ package body Sem_Case is
                Error   => Error);
 
             --  The analysis detected an illegal intersection between a choice
-            --  and a static predicate set.
+            --  and a static predicate set. Do not examine other choices unless
+            --  all errors are requested.
 
             if Error then
-               return;
+               Predicate_Error := True;
+               if not All_Errors_Mode then
+                  return;
+               end if;
             end if;
          end loop;
 
+         if Predicate_Error then
+            return;
+         end if;
+
          --  The choices may legally cover some of the static predicate sets,
          --  but not all. Emit an error for each non-covered set.
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d94ae26..73a63e7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8586,56 +8586,55 @@ package body Sem_Ch3 is
       --  The derived type inherits the representation clauses of the parent.
       --  However, for a private type that is completed by a derivation, there
       --  may be operation attributes that have been specified already (stream
-      --  attributes and External_Tag) and those must be provided. Finally,
-      --  if the partial view is a private extension, the representation items
-      --  of the parent have been inherited already, and should not be chained
+      --  attributes and External_Tag) and those must be provided. Finally, if
+      --  the partial view is a private extension, the representation items of
+      --  the parent have been inherited already, and should not be chained
       --  twice to the derived type.
 
-      if Is_Tagged_Type (Parent_Type)
-        and then Present (First_Rep_Item (Derived_Type))
-      then
-         --  The existing items are either operational items or items inherited
-         --  from a private extension declaration.
+      --  Historic note: The guard below used to check whether the parent type
+      --  is tagged. This is no longer needed because an untagged derived type
+      --  may carry rep items of its own as a result of certain SPARK pragmas.
+      --  With the old guard in place, the rep items of the derived type were
+      --  clobbered.
 
+      if Present (First_Rep_Item (Derived_Type)) then
          declare
-            Rep : Node_Id;
-            --  Used to iterate over representation items of the derived type
-
-            Last_Rep : Node_Id;
-            --  Last representation item of the (non-empty) representation
-            --  item list of the derived type.
-
-            Found : Boolean := False;
+            Par_Item  : constant Node_Id := First_Rep_Item (Parent_Type);
+            Inherited : Boolean := False;
+            Item      : Node_Id;
+            Last_Item : Node_Id;
 
          begin
-            Rep      := First_Rep_Item (Derived_Type);
-            Last_Rep := Rep;
-            while Present (Rep) loop
-               if Rep = First_Rep_Item (Parent_Type) then
-                  Found := True;
+            --  Inspect the rep item chain of the derived type and perform the
+            --  following two functions:
+            --    1) Determine whether the derived type already inherited the
+            --       rep items of the parent type.
+            --    2) Find the last rep item of the derived type
+
+            Item := First_Rep_Item (Derived_Type);
+            Last_Item := Item;
+            while Present (Item) loop
+               if Item = Par_Item then
+                  Inherited := True;
                   exit;
-
-               else
-                  Rep := Next_Rep_Item (Rep);
-
-                  if Present (Rep) then
-                     Last_Rep := Rep;
-                  end if;
                end if;
+
+               Last_Item := Item;
+               Item := Next_Rep_Item (Item);
             end loop;
 
-            --  Here if we either encountered the parent type's first rep
-            --  item on the derived type's rep item list (in which case
-            --  Found is True, and we have nothing else to do), or if we
-            --  reached the last rep item of the derived type, which is
-            --  Last_Rep, in which case we further chain the parent type's
-            --  rep items to those of the derived type.
+            --  Nothing to do if the derived type already inherited the rep
+            --  items from the parent type, otherwise append the parent rep
+            --  item chain to that of the derived type.
 
-            if not Found then
-               Set_Next_Rep_Item (Last_Rep, First_Rep_Item (Parent_Type));
+            if not Inherited then
+               Set_Next_Rep_Item (Last_Item, Par_Item);
             end if;
          end;
 
+      --  Otherwise the derived type lacks rep items and directly inherits the
+      --  rep items of the parent type.
+
       else
          Set_First_Rep_Item (Derived_Type, First_Rep_Item (Parent_Type));
       end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f8c6bd3..0b2accf 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7993,7 +7993,37 @@ package body Sem_Prag is
                      end if;
                   end;
 
-                  Set_Has_Completion (Def_Id);
+                  --  If the pragma comes from an aspect specification, there
+                  --  must be an Import aspect specified as well. In the rare
+                  --  case where Import is set to False, the suprogram needs to
+                  --  have a local completion.
+
+                  declare
+                     Imp_Aspect : constant Node_Id :=
+                                    Find_Aspect (Def_Id, Aspect_Import);
+                     Expr       : Node_Id;
+
+                  begin
+                     if Present (Imp_Aspect)
+                       and then Present (Expression (Imp_Aspect))
+                     then
+                        Expr := Expression (Imp_Aspect);
+                        Analyze_And_Resolve (Expr, Standard_Boolean);
+
+                        if Is_Entity_Name (Expr)
+                          and then Entity (Expr) = Standard_True
+                        then
+                           Set_Has_Completion (Def_Id);
+                        end if;
+
+                     --  If there is no expression, the default is True, as for
+                     --  all boolean aspects. Same for the older pragma.
+
+                     else
+                        Set_Has_Completion (Def_Id);
+                     end if;
+                  end;
+
                   Process_Interface_Name (Def_Id, Arg3, Arg4);
                end if;