[multiple changes]

2013-02-06  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Discriminant_Check): Look for discriminant
	constraint in full view of private type when needed.
	* sem_ch12.adb (Validate_Array_Type_Instance): Specialize
	previous patch to components types that are private and without
	discriminants.

2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Find_Enclosing_Context): Recognize
	a simple return statement as one of the cases that require special
	processing with respect to temporary controlled function results.
	(Process_Transient_Object): Do attempt to finalize a temporary
	controlled function result when the associated context is
	a simple return statement.  Instead, leave this task to the
	general finalization mechanism.

2013-02-06  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads: Minor reformatting.
	(Status_Flag_Or_Transient_Decl): Add ??? comment.

From-SVN: r195791

gcc/ada/ChangeLog

+2013-02-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Apply_Discriminant_Check): Look for discriminant
+	constraint in full view of private type when needed.
+	* sem_ch12.adb (Validate_Array_Type_Instance): Specialize
+	previous patch to components types that are private and without
+	discriminants.
+
+2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Find_Enclosing_Context): Recognize
+	a simple return statement as one of the cases that require special
+	processing with respect to temporary controlled function results.
+	(Process_Transient_Object): Do attempt to finalize a temporary
+	controlled function result when the associated context is
+	a simple return statement.  Instead, leave this task to the
+	general finalization mechanism.
+
+2013-02-06  Thomas Quinot  <quinot@adacore.com>
+
+	* einfo.ads: Minor reformatting.
+	(Status_Flag_Or_Transient_Decl): Add ??? comment.
+
 2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This

gcc/ada/checks.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- --
@@ -1536,8 +1536,8 @@ package body Checks is
       --  the constraints are constants. In this case, we can do the check
       --  successfully at compile time.
 
-      --  We skip this check for the case where the node is a rewritten`
-      --  allocator, because it already carries the context subtype, and
+      --  We skip this check for the case where the node is a rewritten`as
+      --  an allocator, because it already carries the context subtype, and
       --  extracting the discriminants from the aggregate is messy.
 
       if Is_Constrained (S_Typ)
@@ -1591,7 +1591,17 @@ package body Checks is
                end if;
             end if;
 
-            DconT  := First_Elmt (Discriminant_Constraint (T_Typ));
+            --  Constraint may appear in full view of type
+
+            if Ekind (T_Typ) = E_Private_Subtype
+              and then Present (Full_View (T_Typ))
+            then
+               DconT  :=
+                 First_Elmt (Discriminant_Constraint (Full_View (T_Typ)));
+
+            else
+               DconT  := First_Elmt (Discriminant_Constraint (T_Typ));
+            end if;
 
             while Present (Discr) loop
                ItemS := Node (DconS);

gcc/ada/einfo.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -3725,11 +3725,12 @@ package Einfo is
 
 --    Status_Flag_Or_Transient_Decl (Node15)
 --       Defined in variables and constants. Applies to objects that require
---       special treatment by the finalization machinery. Such examples are
---       extended return results, if and case expression results and objects
---       inside N_Expression_With_Actions nodes. The attribute contains the
---       entity of a flag which specifies particular behavior over a region
---       of code or the declaration of a "hook" object.
+--       special treatment by the finalization machinery, such as extended
+--       return results, IF and CASE expression results, and objects inside
+--       N_Expression_With_Actions nodes. The attribute contains the entity
+--       of a flag which specifies particular behavior over a region of code
+--       or the declaration of a "hook" object.
+--       In which case is it a flag, or a hook object???
 
 --    Storage_Size_Variable (Node15) [implementation base type only]
 --       Defined in access types and task type entities. This flag is set

gcc/ada/exp_ch4.adb

@@ -5038,7 +5038,7 @@ package body Exp_Ch4 is
             --  Start of processing for Find_Enclosing_Context
 
             begin
-               --  The expression_with_action is in a case or if expression and
+               --  The expression_with_actions is in a case/if expression and
                --  the lifetime of any temporary controlled object is therefore
                --  extended. Find a suitable insertion node by locating the top
                --  most case or if expressions.
@@ -5088,12 +5088,12 @@ package body Exp_Ch4 is
 
                   return Par;
 
-               --  Shor circuit operators in complex expressions are converted
+               --  Short circuit operators in complex expressions are converted
                --  into expression_with_actions.
 
                else
                   --  Take care of the case where the expression_with_actions
-                  --  is burried deep inside an if statement. The temporary
+                  --  is buried deep inside an IF statement. The temporary
                   --  function result must be finalized before the then, elsif
                   --  or else statements are evaluated.
 
@@ -5123,7 +5123,7 @@ package body Exp_Ch4 is
 
                   Top := Par;
 
-                  --  The expression_with_action might be located in a pragm
+                  --  The expression_with_actions might be located in a pragma
                   --  in which case locate the pragma itself:
 
                   --    pragma Precondition (... and then Ctrl_Func_Call ...);
@@ -5133,10 +5133,16 @@ package body Exp_Ch4 is
 
                   --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
 
+                  --  Another case to consider is an expression_with_actions as
+                  --  part of a return statement:
+
+                  --    return ... and then Ctrl_Func_Call ...;
+
                   while Present (Par) loop
                      if Nkind_In (Par, N_Assignment_Statement,
                                        N_Object_Declaration,
-                                       N_Pragma)
+                                       N_Pragma,
+                                       N_Simple_Return_Statement)
                      then
                         return Par;
 
@@ -5238,23 +5244,32 @@ package body Exp_Ch4 is
             --       Temp := null;
             --    end if;
 
-            Insert_Action_After (Context,
-              Make_If_Statement (Loc,
-                Condition =>
-                  Make_Op_Ne (Loc,
-                    Left_Opnd  => New_Reference_To (Temp_Id, Loc),
-                    Right_Opnd => Make_Null (Loc)),
-
-                Then_Statements => New_List (
-                  Make_Final_Call
-                    (Obj_Ref =>
-                       Make_Explicit_Dereference (Loc,
-                         Prefix => New_Reference_To (Temp_Id, Loc)),
-                     Typ     => Desig_Typ),
+            --  When the expression_with_actions is part of a return statement,
+            --  there is no need to insert a finalization call, as the general
+            --  finalization mechanism (see Build_Finalizer) would take care of
+            --  the temporary function result on subprogram exit. Note that it
+            --  would also be impossible to insert the finalization code after
+            --  the return statement as this would make it unreachable.
+
+            if Nkind (Context) /= N_Simple_Return_Statement then
+               Insert_Action_After (Context,
+                 Make_If_Statement (Loc,
+                   Condition =>
+                     Make_Op_Ne (Loc,
+                       Left_Opnd  => New_Reference_To (Temp_Id, Loc),
+                       Right_Opnd => Make_Null (Loc)),
+
+                   Then_Statements => New_List (
+                     Make_Final_Call
+                       (Obj_Ref =>
+                          Make_Explicit_Dereference (Loc,
+                            Prefix => New_Reference_To (Temp_Id, Loc)),
+                        Typ     => Desig_Typ),
 
-                  Make_Assignment_Statement (Loc,
-                    Name       => New_Reference_To (Temp_Id, Loc),
-                    Expression => Make_Null (Loc)))));
+                     Make_Assignment_Statement (Loc,
+                       Name       => New_Reference_To (Temp_Id, Loc),
+                       Expression => Make_Null (Loc)))));
+            end if;
          end Process_Transient_Object;
 
       --  Start of processing for Process_Action

gcc/ada/sem_ch12.adb

@@ -10708,10 +10708,14 @@ package body Sem_Ch12 is
              or else Subtypes_Match
                (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
                Component_Type (Act_T))
-             or else Subtypes_Match
-               (Base_Type
-                 (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
-               Component_Type (Act_T))
+             or else
+               (Is_Private_Type (Component_Type (A_Gen_T))
+                 and then not Has_Discriminants (Component_Type (A_Gen_T))
+                 and then
+                  Subtypes_Match
+                    (Base_Type
+                      (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
+                    Component_Type (Act_T)))
          then
             null;
          else