From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Thu, 31 Jul 2014 09:35:27 +0000 (+0200)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2fe258bf9315fa25f620860f99462faa8ade3b68;p=gcc.git

[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 0d3638d98bd..b88d174fd88 100644
--- 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 520f9329bd3..53985f19c32 100644
--- 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 5864dfceb0d..aad47610876 100644
--- 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 7454eaefcf3..bbbf712dde0 100644
--- 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 77c32943621..cce2a4803ff 100644
--- 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;