2013-01-29 Ed Schonberg <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): An expression
	function declaration is not a subprogram declaration, and thus
	cannot appear in a protected definition.

2013-01-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Insert_Actions): When new
	actions come from the expression of the expression with actions,
	then they must be added to the list of existing actions.

2013-01-29  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration) <Private_Kind>: For
	the subtype of a constrained private type with discriminants
	that has got a full view, show that the completion is a clone
	of the full view.



git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@195543 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 67 insertions, 21 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f25b41c4321..076ae03f833 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2013-01-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Expression_Function): An expression
+	function declaration is not a subprogram declaration, and thus
+	cannot appear in a protected definition.
+
+2013-01-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Insert_Actions): When new
+	actions come from the expression of the expression with actions,
+	then they must be added to the list of existing actions.
+
+2013-01-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch3.adb (Analyze_Subtype_Declaration) <Private_Kind>: For
+	the subtype of a constrained private type with discriminants
+	that has got a full view, show that the completion is a clone
+	of the full view.
+
 2013-01-29  Javier Miranda  <miranda@adacore.com>
 
 	* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c38ed030fb0..4e04ae859aa 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -3141,25 +3141,27 @@ package body Exp_Util is
 
       --  N_Raise_xxx_Error is an annoying special case, it is a statement if
       --  it has type Standard_Void_Type, and a subexpression otherwise.
-      --  otherwise. Procedure attribute references are also statements.
+      --  otherwise. Procedure calls, and similarly procedure attribute
+      --  references, are also statements.
 
       if Nkind (Assoc_Node) in N_Subexpr
-        and then (Nkind (Assoc_Node) in N_Raise_xxx_Error
+        and then (Nkind (Assoc_Node) not in N_Raise_xxx_Error
                    or else Etype (Assoc_Node) /= Standard_Void_Type)
+        and then Nkind (Assoc_Node) /= N_Procedure_Call_Statement
         and then (Nkind (Assoc_Node) /= N_Attribute_Reference
                    or else
                      not Is_Procedure_Attribute_Name
                            (Attribute_Name (Assoc_Node)))
       then
-         P := Assoc_Node;             -- ??? does not agree with above!
-         N := Parent (Assoc_Node);
+         N := Assoc_Node;
+         P := Parent (Assoc_Node);
 
       --  Non-subexpression case. Note that N is initially Empty in this case
       --  (N is only guaranteed Non-Empty in the subexpr case).
 
       else
-         P := Assoc_Node;
          N := Empty;
+         P := Assoc_Node;
       end if;
 
       --  Capture root of the transient scope
@@ -3171,6 +3173,13 @@ package body Exp_Util is
       loop
          pragma Assert (Present (P));
 
+         --  Make sure that inserted actions stay in the transient scope
+
+         if Present (Wrapped_Node) and then N = Wrapped_Node then
+            Store_Before_Actions_In_Scope (Ins_Actions);
+            return;
+         end if;
+
          case Nkind (P) is
 
             --  Case of right operand of AND THEN or OR ELSE. Put the actions
@@ -3282,14 +3291,17 @@ package body Exp_Util is
 
                return;
 
-            --  Case of appearing within an Expressions_With_Actions node. We
-            --  append the actions to the list of actions already there, if
-            --  the node has not been analyzed yet. Otherwise find insertion
-            --  location further up the tree.
+            --  Case of appearing within an Expressions_With_Actions node. When
+            --  the new actions come from the expression of the expression with
+            --  actions, they must be added to the existing actions. The other
+            --  alternative is when the new actions are related to one of the
+            --  existing actions of the expression with actions. In that case
+            --  they must be inserted further up the tree.
 
             when N_Expression_With_Actions =>
-               if not Analyzed (P) then
-                  Append_List (Ins_Actions, Actions (P));
+               if N = Expression (P) then
+                  Insert_List_After_And_Analyze
+                    (Last (Actions (P)), Ins_Actions);
                   return;
                end if;
 
@@ -3697,13 +3709,6 @@ package body Exp_Util is
 
          end case;
 
-         --  Make sure that inserted actions stay in the transient scope
-
-         if P = Wrapped_Node then
-            Store_Before_Actions_In_Scope (Ins_Actions);
-            return;
-         end if;
-
          --  If we fall through above tests, keep climbing tree
 
          N := P;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5ccfe801fa9..f5e0bec769f 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4282,14 +4282,27 @@ package body Sem_Ch3 is
                   Set_Stored_Constraint_From_Discriminant_Constraint (Id);
 
                   --  This would seem semantically correct, but apparently
-                  --  confuses the back-end. To be explained and checked with
-                  --  current version ???
+                  --  generates spurious errors about missing components ???
 
                   --  Set_Has_Discriminants (Id);
                end if;
 
                Prepare_Private_Subtype_Completion (Id, N);
 
+               --  If this is the subtype of a constrained private type with
+               --  discriminants that has got a full view and we also have
+               --  built a completion just above, show that the completion
+               --  is a clone of the full view to the back-end.
+
+               if Has_Discriminants (T)
+                  and then not Has_Unknown_Discriminants (T)
+                  and then not Is_Empty_Elmt_List (Discriminant_Constraint (T))
+                  and then Present (Full_View (T))
+                  and then Present (Full_View (Id))
+               then
+                  Set_Cloned_Subtype (Full_View (Id), Full_View (T));
+               end if;
+
             when Access_Kind =>
                Set_Ekind             (Id, E_Access_Subtype);
                Set_Is_Constrained    (Id, Is_Constrained        (T));
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 7d67850f6ab..68eeea347d0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -408,6 +408,15 @@ package body Sem_Ch6 is
       --  that the expression can be inlined whenever possible.
 
       else
+         --  An expression function that is not a completion is not a
+         --  subprogram declaration, and thus cannot appear in a protected
+         --  definition.
+
+         if Nkind (Parent (N)) = N_Protected_Definition then
+            Error_Msg_N
+              ("an expression function is not a legal protected operation", N);
+         end if;
+
          New_Decl :=
            Make_Subprogram_Declaration (Loc, Specification => Spec);