+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
-- 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
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
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
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.
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.
-- 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
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);
-- 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));
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));
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
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;
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
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
-- 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
-- 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
-- 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
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
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
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);
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);
projects / thirdparty / gcc.git / commitdiff
