[multiple changes]

2014-07-29  Thomas Quinot  <quinot@adacore.com>

	* errout.adb (Set_Error_Posted): When propagating flag to
	an enclosing named association, also propagate to the parent
	of that node, so that named and positional associations are
	treated consistently.

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

	* sem_attr.adb (Resolve_Attribute, case 'Update):  Set
	Do_Range_Check properly on array component expressions that
	have a scalar type. In GNATprove mode, only checks on scalar
	components must be marked by the front-end.

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

	* sem_res.adb (Resolve_Type_Conversion): If the type of the
	expression is a limited view, use the non-limited view when
	available.

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Case_Expression): Mark the generated
	case statement as coming from a conditional expression.
	(Expand_N_If_Expression): Mark the generated if statement as
	coming from a conditional expression.
	* exp_ch5.adb (Expand_N_Case_Statement): Do not process controlled
	objects found in case statement alternatives when the case
	statement is actually a case expression.
	(Expand_N_If_Statement):
	Do not process controlled objects found in an if statement when
	the if statement is actually an if expression.
	* sinfo.adb (From_Conditional_Expression): New routine.
	(Set_From_Conditional_Expression): New routine.
	* sinfo.ads Add new semantic flag From_Conditional_Expression and
	update related nodes.
	(From_Conditional_Expression): New routine along with pragma Inline.
	(Set_From_Conditional_Expression): New routine along with pragma Inline.

From-SVN: r213156

8 files changed, 176 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7933eb7..b74401a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2014-07-29  Thomas Quinot  <quinot@adacore.com>
+
+	* errout.adb (Set_Error_Posted): When propagating flag to
+	an enclosing named association, also propagate to the parent
+	of that node, so that named and positional associations are
+	treated consistently.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Resolve_Attribute, case 'Update):  Set
+	Do_Range_Check properly on array component expressions that
+	have a scalar type. In GNATprove mode, only checks on scalar
+	components must be marked by the front-end.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Type_Conversion): If the type of the
+	expression is a limited view, use the non-limited view when
+	available.
+
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Case_Expression): Mark the generated
+	case statement as coming from a conditional expression.
+	(Expand_N_If_Expression): Mark the generated if statement as
+	coming from a conditional expression.
+	* exp_ch5.adb (Expand_N_Case_Statement): Do not process controlled
+	objects found in case statement alternatives when the case
+	statement is actually a case expression.
+	(Expand_N_If_Statement):
+	Do not process controlled objects found in an if statement when
+	the if statement is actually an if expression.
+	* sinfo.adb (From_Conditional_Expression): New routine.
+	(Set_From_Conditional_Expression): New routine.
+	* sinfo.ads Add new semantic flag From_Conditional_Expression and
+	update related nodes.
+	(From_Conditional_Expression): New routine along with pragma Inline.
+	(Set_From_Conditional_Expression): New routine along with pragma Inline.
+
 2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch7.adb (Build_BIP_Cleanup_Stmts): Remove
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index a2e9b45..a18627c 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -156,11 +156,12 @@ package body Errout is
    --  variables Msg_Buffer are set on return Msglen.
 
    procedure Set_Posted (N : Node_Id);
-   --  Sets the Error_Posted flag on the given node, and all its parents
-   --  that are subexpressions and then on the parent non-subexpression
-   --  construct that contains the original expression (this reduces the
-   --  number of cascaded messages). Note that this call only has an effect
-   --  for a serious error. For a non-serious error, it has no effect.
+   --  Sets the Error_Posted flag on the given node, and all its parents that
+   --  are subexpressions and then on the parent non-subexpression construct
+   --  that contains the original expression. If that parent is a named
+   --  association, the flag is further propagated to its parent. This is done
+   --  in order to guard against cascaded errors. Note that this call has an
+   --  effect for a serious error only.
 
    procedure Set_Qualification (N : Nat; E : Entity_Id);
    --  Outputs up to N levels of qualification for the given entity. For
@@ -3007,6 +3008,16 @@ package body Errout is
             exit when Nkind (P) not in N_Subexpr;
          end loop;
 
+         if Nkind_In (P,
+              N_Pragma_Argument_Association,
+              N_Component_Association,
+              N_Discriminant_Association,
+              N_Generic_Association,
+              N_Parameter_Association)
+         then
+            Set_Error_Posted (Parent (P));
+         end if;
+
          --  A special check, if we just posted an error on an attribute
          --  definition clause, then also set the entity involved as posted.
          --  For example, this stops complaining about the alignment after
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index adf8dfc..9abe25a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4991,6 +4991,13 @@ package body Exp_Ch4 is
           Expression   => Expression (N),
           Alternatives => New_List);
 
+      --  Preserve the original context for which the case statement is being
+      --  generated. This is needed by the finalization machinery to prevent
+      --  the premature finalization of controlled objects found within the
+      --  case statement.
+
+      Set_From_Conditional_Expression (Cstmt);
+
       Actions := New_List;
 
       --  Scalar case
@@ -5354,9 +5361,16 @@ package body Exp_Ch4 is
                      Prefix         => Relocate_Node (Elsex),
                      Attribute_Name => Name_Unrestricted_Access))));
 
-            New_N :=
-              Make_Explicit_Dereference (Loc,
-                Prefix => New_Occurrence_Of (Cnn, Loc));
+         --  Preserve the original context for which the if statement is being
+         --  generated. This is needed by the finalization machinery to prevent
+         --  the premature finalization of controlled objects found within the
+         --  if statement.
+
+         Set_From_Conditional_Expression (New_If);
+
+         New_N :=
+           Make_Explicit_Dereference (Loc,
+             Prefix => New_Occurrence_Of (Cnn, Loc));
 
       --  For other types, we only need to expand if there are other actions
       --  associated with either branch.
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index eb621b3..338050e 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2524,7 +2524,13 @@ package body Exp_Ch5 is
       if Compile_Time_Known_Value (Expr) then
          Alt := Find_Static_Alternative (N);
 
-         Process_Statements_For_Controlled_Objects (Alt);
+         --  Do not consider controlled objects found in a case statement which
+         --  actually models a case expression because their early finalization
+         --  will affect the result of the expression.
+
+         if not From_Conditional_Expression (N) then
+            Process_Statements_For_Controlled_Objects (Alt);
+         end if;
 
          --  Move statements from this alternative after the case statement.
          --  They are already analyzed, so will be skipped by the analyzer.
@@ -2603,10 +2609,16 @@ package body Exp_Ch5 is
             --  effects.
 
             Remove_Side_Effects (Expression (N));
-
             Alt := First (Alternatives (N));
 
-            Process_Statements_For_Controlled_Objects (Alt);
+            --  Do not consider controlled objects found in a case statement
+            --  which actually models a case expression because their early
+            --  finalization will affect the result of the expression.
+
+            if not From_Conditional_Expression (N) then
+               Process_Statements_For_Controlled_Objects (Alt);
+            end if;
+
             Insert_List_After (N, Statements (Alt));
 
             --  That leaves the case statement as a shell. The alternative that
@@ -2711,7 +2723,14 @@ package body Exp_Ch5 is
 
          Alt := First_Non_Pragma (Alternatives (N));
          while Present (Alt) loop
-            Process_Statements_For_Controlled_Objects (Alt);
+
+            --  Do not consider controlled objects found in a case statement
+            --  which actually models a case expression because their early
+            --  finalization will affect the result of the expression.
+
+            if not From_Conditional_Expression (N) then
+               Process_Statements_For_Controlled_Objects (Alt);
+            end if;
 
             if Has_SP_Choice (Alt) then
                Expand_Static_Predicates_In_Choices (Alt);
@@ -2914,7 +2933,13 @@ package body Exp_Ch5 is
       --  these warnings for expander generated code.
 
    begin
-      Process_Statements_For_Controlled_Objects (N);
+      --  Do not consider controlled objects found in an if statement which
+      --  actually models an if expression because their early finalization
+      --  will affect the result of the expression.
+
+      if not From_Conditional_Expression (N) then
+         Process_Statements_For_Controlled_Objects (N);
+      end if;
 
       Adjust_Condition (Condition (N));
 
@@ -3001,7 +3026,14 @@ package body Exp_Ch5 is
       if Present (Elsif_Parts (N)) then
          E := First (Elsif_Parts (N));
          while Present (E) loop
-            Process_Statements_For_Controlled_Objects (E);
+
+            --  Do not consider controlled objects found in an if statement
+            --  which actually models an if expression because their early
+            --  finalization will affect the result of the expression.
+
+            if not From_Conditional_Expression (N) then
+               Process_Statements_For_Controlled_Objects (E);
+            end if;
 
             Adjust_Condition (Condition (E));
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 9cb42b9..114f42e 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10836,7 +10836,25 @@ package body Sem_Attr is
                   while Present (Assoc) loop
                      Expr  := Expression (Assoc);
                      Resolve (Expr, Component_Type (Typ));
-                     Aggregate_Constraint_Checks (Expr, Component_Type (Typ));
+
+                     --  For scalar array components set Do_Range_Check when
+                     --  needed. Constraint checking on non-scalar components
+                     --  is done in Aggregate_Constraint_Checks, but only if
+                     --  full analysis is enabled. These flags are not set in
+                     --  the front-end in GnatProve mode.
+
+                     if Is_Scalar_Type (Component_Type (Typ))
+                       and then not Is_OK_Static_Expression (Expr)
+                     then
+                        if Is_Entity_Name (Expr)
+                          and then Etype (Expr) = Component_Type (Typ)
+                        then
+                           null;
+
+                        else
+                           Set_Do_Range_Check (Expr);
+                        end if;
+                     end if;
 
                      --  The choices in the association are static constants,
                      --  or static aggregates each of whose components belongs
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 97a11d1..51b151e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10193,6 +10193,17 @@ package body Sem_Res is
             Target : Entity_Id := Target_Typ;
 
          begin
+            --  If the type of the operand is a limited view, use the non-
+            --  limited view when available.
+
+            if From_Limited_With (Opnd)
+              and then Ekind (Opnd) in Incomplete_Kind
+              and then Present (Non_Limited_View (Opnd))
+            then
+               Opnd := Non_Limited_View (Opnd);
+               Set_Etype (Expression (N), Opnd);
+            end if;
+
             if Is_Access_Type (Opnd) then
                Opnd := Designated_Type (Opnd);
             end if;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 2d21669..232e0bc 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1400,6 +1400,15 @@ package body Sinfo is
       return Flag4 (N);
    end From_At_Mod;
 
+   function From_Conditional_Expression
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Statement
+        or else NT (N).Nkind = N_If_Statement);
+      return Flag1 (N);
+   end From_Conditional_Expression;
+
    function From_Default
       (N : Node_Id) return Boolean is
    begin
@@ -4574,6 +4583,15 @@ package body Sinfo is
       Set_Flag4 (N, Val);
    end Set_From_At_Mod;
 
+   procedure Set_From_Conditional_Expression
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Statement
+        or else NT (N).Nkind = N_If_Statement);
+      Set_Flag1 (N, Val);
+   end Set_From_Conditional_Expression;
+
    procedure Set_From_Default
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 36bd33f..f02fe51 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1291,6 +1291,11 @@ package Sinfo is
    --    must be a multiple of the given value, and the representation clause
    --    is considered to be type specific instead of subtype specific.
 
+   --  From_Conditional_Expression (Flag1-Sem)
+   --    This flag is set on if and case statements generated by the expansion
+   --    of if and case expressions respectively. The flag is used to suppress
+   --    any finalization of controlled objects found within these statements.
+
    --  From_Default (Flag6-Sem)
    --    This flag is set on the subprogram renaming declaration created in an
    --    instance for a formal subprogram, when the formal is declared with a
@@ -4569,6 +4574,7 @@ package Sinfo is
       --  Elsif_Parts (List3) (set to No_List if none present)
       --  Else_Statements (List4) (set to No_List if no else part present)
       --  End_Span (Uint5) (set to Uint_0 if expander generated)
+      --  From_Conditional_Expression (Flag1-Sem)
 
       --  N_Elsif_Part
       --  Sloc points to ELSIF
@@ -4601,6 +4607,7 @@ package Sinfo is
       --  Expression (Node3)
       --  Alternatives (List4)
       --  End_Span (Uint5) (set to Uint_0 if expander generated)
+      --  From_Conditional_Expression (Flag1-Sem)
 
       --  Note: Before Ada 2012, a pragma in a statement sequence is always
       --  followed by a statement, and this is true in the tree even in Ada
@@ -9031,6 +9038,9 @@ package Sinfo is
    function From_At_Mod
      (N : Node_Id) return Boolean;    -- Flag4
 
+   function From_Conditional_Expression
+     (N : Node_Id) return Boolean;    -- Flag1
+
    function From_Default
      (N : Node_Id) return Boolean;    -- Flag6
 
@@ -10032,15 +10042,18 @@ package Sinfo is
    procedure Set_Forwards_OK
      (N : Node_Id; Val : Boolean := True);    -- Flag5
 
-   procedure Set_From_At_Mod
-     (N : Node_Id; Val : Boolean := True);    -- Flag4
-
    procedure Set_From_Aspect_Specification
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
    procedure Set_From_At_End
      (N : Node_Id; Val : Boolean := True);    -- Flag4
 
+   procedure Set_From_At_Mod
+     (N : Node_Id; Val : Boolean := True);    -- Flag4
+
+   procedure Set_From_Conditional_Expression
+     (N : Node_Id; Val : Boolean := True);    -- Flag1
+
    procedure Set_From_Default
      (N : Node_Id; Val : Boolean := True);    -- Flag6
 
@@ -12527,6 +12540,7 @@ package Sinfo is
    pragma Inline (From_Aspect_Specification);
    pragma Inline (From_At_End);
    pragma Inline (From_At_Mod);
+   pragma Inline (From_Conditional_Expression);
    pragma Inline (From_Default);
    pragma Inline (Generalized_Indexing);
    pragma Inline (Generic_Associations);
@@ -12861,6 +12875,7 @@ package Sinfo is
    pragma Inline (Set_From_Aspect_Specification);
    pragma Inline (Set_From_At_End);
    pragma Inline (Set_From_At_Mod);
+   pragma Inline (Set_From_Conditional_Expression);
    pragma Inline (Set_From_Default);
    pragma Inline (Set_Generalized_Indexing);
    pragma Inline (Set_Generic_Associations);