mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-12 13:11:48 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2014-07-29 14:44:34 +02:00
parent 0382062b3b
commit 414c65636f
8 changed files with 176 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
gcc/ada/ChangeLog
View File

@ -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

21
gcc/ada/errout.adb
View File

@ -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

20
gcc/ada/exp_ch4.adb
View File

@ -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.

44
gcc/ada/exp_ch5.adb
View File

@ -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));

20
gcc/ada/sem_attr.adb
View File

@ -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

11
gcc/ada/sem_res.adb
View File

@ -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;

18
gcc/ada/sinfo.adb
View File

@ -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

21
gcc/ada/sinfo.ads
View File

@ -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);