[COMMITTED] ada: Fix crash caused by incorrect expansion of iterated component
Checks
Commit Message
The way iterated component are expanded could lead to inconsistent tree.
This change fixes 2 issues:
- in an early step during Pre_Analyze, the loop variable still has
Any_Type and the compiler must not emit an error. A later full Analyze
is supposed to correctly set the Etype, and only then should the
compiler emit an error if Any_Type is still used.
- when expanding into a loop with assignments statement, the expression
is analyzed in an early context (where the loop variable still has
Any_Type Etype) and then copied. The compiler would crash because this
Any_Type is never changed because the expression node has its Analyzed
flag set. Resetting the flag ensures the later Analyze call also
analyzes these nodes and set Etype correctly.
gcc/ada/
* exp_aggr.adb (Process_Transient_Component): Reset Analyzed flag
for the copy of the initialization expression.
* sem_attr.adb (Validate_Non_Static_Attribute_Function_Call): Skip
error emission during Pre_Analyze.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 11 ++++++++++-
gcc/ada/sem_attr.adb | 4 +++-
2 files changed, 13 insertions(+), 2 deletions(-)
@@ -9840,6 +9840,7 @@ package body Exp_Aggr is
Res_Decl : Node_Id;
Res_Id : Entity_Id;
Res_Typ : Entity_Id;
+ Copy_Init_Expr : constant Node_Id := New_Copy_Tree (Init_Expr);
-- Start of processing for Process_Transient_Component
@@ -9890,7 +9891,15 @@ package body Exp_Aggr is
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Res_Typ, Loc),
Expression =>
- Make_Reference (Loc, New_Copy_Tree (Init_Expr)));
+ Make_Reference (Loc, Copy_Init_Expr));
+
+ -- In some cases, like iterated component, the Init_Expr may have been
+ -- analyzed in a context where all the Etype fields are not correct yet
+ -- and a later call to Analyze is expected to set them.
+ -- Resetting the Analyzed flag ensures this later call doesn't skip this
+ -- node.
+
+ Reset_Analyzed_Flags (Copy_Init_Expr);
Add_Item (Res_Decl);
@@ -3319,7 +3319,9 @@ package body Sem_Attr is
-- Check for missing/bad expression (result of previous error)
- if No (E1) or else Etype (E1) = Any_Type then
+ if No (E1)
+ or else (Etype (E1) = Any_Type and then Full_Analysis)
+ then
Check_Error_Detected;
raise Bad_Attribute;
end if;