[multiple changes]

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb: Minor reformatting.

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Build_Invariant_Checks): If the enclosing record
	is an unchecked_union, warn that invariants will not be checked
	on components that have them.

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Entity): Check for error of
	Type_Invariant'Class applied to a untagged type.
	* sem_ch6.adb (Analyze_Null_Procedure): Unconditionally rewrite
	as null body, so that we perform error checks even if expansion
	is off.

From-SVN: r213324

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0d3638d98bdc376a3a1e14f997ba173dc56dd59c..b88d174fd88c087a34c420bd942bfb6b6c93ebaf 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2014-07-31  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch13.adb: Minor reformatting.
+
+2014-07-31  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch3.adb (Build_Invariant_Checks): If the enclosing record
+       is an unchecked_union, warn that invariants will not be checked
+       on components that have them.
+
+2014-07-31  Robert Dewar  <dewar@adacore.com>
+
+       * freeze.adb (Freeze_Entity): Check for error of
+       Type_Invariant'Class applied to a untagged type.
+       * sem_ch6.adb (Analyze_Null_Procedure): Unconditionally rewrite
+       as null body, so that we perform error checks even if expansion
+       is off.
+
 2014-07-31  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch13.adb (Build_Invariant_Procedure): If body of procedure

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 520f9329bd3347714506532d7a1be1bd7ef47cd0..53985f19c32aaeea3928ed366484918fcb80f07e 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -3763,7 +3763,15 @@ package body Exp_Ch3 is
                if Has_Invariants (Etype (Id))
                  and then In_Open_Scopes (Scope (R_Type))
                then
-                  Append_To (Stmts, Build_Component_Invariant_Call (Id));
+                  if Has_Unchecked_Union (R_Type) then
+                     Error_Msg_NE
+                       ("invariants cannot be checked on components of "
+                         & "unchecked_union type&?", Decl, R_Type);
+                     return Empty_List;
+
+                  else
+                     Append_To (Stmts, Build_Component_Invariant_Call (Id));
+                  end if;
 
                elsif Is_Access_Type (Etype (Id))
                  and then not Is_Access_Constant (Etype (Id))

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5864dfceb0d41b3fa864d1e6018ec1f8541464ad..aad47610876e7f0e0c260a3a3c5ce8163add1ff5 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4537,6 +4537,24 @@ package body Freeze is
             return No_List;
          end if;
 
+         --  Check for error of Type_Invariant'Class applied to a untagged type
+         --  (check delayed to freeze time when full type is available).
+
+         declare
+            Prag : constant Node_Id := Get_Pragma (E, Pragma_Invariant);
+         begin
+            if Present (Prag)
+              and then Class_Present (Prag)
+              and then not Is_Tagged_Type (E)
+            then
+               Error_Msg_NE
+                 ("Type_Invariant''Class cannot be specified for &",
+                  Prag, E);
+               Error_Msg_N
+                 ("\can only be specified for a tagged type", Prag);
+            end if;
+         end;
+
          --  Deal with special cases of freezing for subtype
 
          if E /= Base_Type (E) then

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7454eaefcf38a4aad4b7d791a9020bf2900e228e..bbbf712dde0c6e651d7de362cba5a4e94826a642 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7489,7 +7489,8 @@ package body Sem_Ch13 is
       --  the type is already frozen, which is the case when the invariant
       --  appears in a private part, and the freezing takes place before the
       --  final pass over full declarations.
-      --  See exp_ch3.Insert_Component_Invariant_Checks for details.
+
+      --  See Exp_Ch3.Insert_Component_Invariant_Checks for details.
 
       if Present (SId) then
          PDecl := Unit_Declaration_Node (SId);

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 77c329436213e8447422ee8d982d4dccc647da24..cce2a4803fff19653c0b093fdd097e8b526f228a 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1391,19 +1391,14 @@ package body Sem_Ch6 is
          end if;
 
       else
-         --  The null procedure is a completion
+         --  The null procedure is a completion. We unconditionally rewrite
+         --  this as a null body (even if expansion is not active), because
+         --  there are various error checks that are applied on this body
+         --  when it is analyzed (e.g. correct aspect placement).
 
          Is_Completion := True;
-
-         if Expander_Active then
-            Rewrite (N, Null_Body);
-            Analyze (N);
-
-         else
-            Designator := Analyze_Subprogram_Specification (Spec);
-            Set_Has_Completion (Designator);
-            Set_Has_Completion (Prev);
-         end if;
+         Rewrite (N, Null_Body);
+         Analyze (N);
       end if;
    end Analyze_Null_Procedure;