https://gcc.gnu.org/g:a52223c5b2ba677468b5fabc010492998e4dea3a
commit r15-9766-ga52223c5b2ba677468b5fabc010492998e4dea3a
Author: Gary Dismukes <dismu...@adacore.com>
Date: Fri Jan 10 22:39:52 2025 +0000
ada: Compiler crash on array aggregate association iterating over function
result
The compiler triggers a bug box when compiling an array aggregate with
an iterated_component_association that iterates over another array object,
failing when trying to retrieve a Choices field, which isn't an allowed
field for N_Iterated_Component_Association nodes. This occurs in procedure
Check_Function_Writable_Actuals, which wasn't accounting for the iterated
association forms.
gcc/ada/ChangeLog:
* sem_util.adb (Check_Function_Writable_Actuals): Add handling for
N_Iterated_Component_Association and N_Iterated_Element_Association.
Fix a typo in an RM reference (6.4.1(20/3) => 6.4.1(6.20/3)).
(Collect_Expression_Ids): New procedure factoring code for
collecting
identifiers from expressions of aggregate associations.
(Handle_Association_Choices): New procedure factoring code for
handling
id collection for expressions of aggregate associations with
multiple
choices. Removed redundant test of Box_Present from original code.
Diff:
---
gcc/ada/sem_util.adb | 115 ++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 86 insertions(+), 29 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0e1505bbdbe6..5f9f2755c949 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3025,7 +3025,7 @@ package body Sem_Util is
-- For an array aggregate, a discrete_choice_list that has
-- a nonstatic range is considered as two or more separate
- -- occurrences of the expression (RM 6.4.1(20/3)).
+ -- occurrences of the expression (RM 6.4.1(6.20/3)).
elsif Is_Array_Type (Etype (N))
and then Nkind (N) = N_Aggregate
@@ -3110,48 +3110,105 @@ package body Sem_Util is
end loop;
end if;
- -- Handle discrete associations
+ -- Handle named associations
if Present (Component_Associations (N)) then
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
- if not Box_Present (Assoc) then
- Choice := First (Choices (Assoc));
- while Present (Choice) loop
+ Handle_Association : declare
- -- For now we skip discriminants since it requires
- -- performing the analysis in two phases: first one
- -- analyzing discriminants and second one analyzing
- -- the rest of components since discriminants are
- -- evaluated prior to components: too much extra
- -- work to detect a corner case???
+ procedure Collect_Expression_Ids (Expr : Node_Id);
+ -- Collect identifiers in association expression Expr
- if Nkind (Choice) in N_Has_Entity
- and then Present (Entity (Choice))
- and then Ekind (Entity (Choice)) = E_Discriminant
- then
- null;
+ procedure Handle_Association_Choices
+ (Choices : List_Id; Expr : Node_Id);
+ -- Collect identifiers in an association expression
+ -- Expr for each choice in Choices.
- elsif Box_Present (Assoc) then
- null;
+ ----------------------------
+ -- Collect_Expression_Ids --
+ ----------------------------
+ procedure Collect_Expression_Ids (Expr : Node_Id) is
+ Comp_Expr : Node_Id;
+
+ begin
+ if not Analyzed (Expr) then
+ Comp_Expr := New_Copy_Tree (Expr);
+ Set_Parent (Comp_Expr, Parent (N));
+ Preanalyze_Without_Errors (Comp_Expr);
else
- if not Analyzed (Expression (Assoc)) then
- Comp_Expr :=
- New_Copy_Tree (Expression (Assoc));
- Set_Parent (Comp_Expr, Parent (N));
- Preanalyze_Without_Errors (Comp_Expr);
+ Comp_Expr := Expr;
+ end if;
+
+ Collect_Identifiers (Comp_Expr);
+ end Collect_Expression_Ids;
+
+ --------------------------------
+ -- Handle_Association_Choices --
+ --------------------------------
+
+ procedure Handle_Association_Choices
+ (Choices : List_Id; Expr : Node_Id)
+ is
+ Choice : Node_Id := First (Choices);
+
+ begin
+ while Present (Choice) loop
+
+ -- For now skip discriminants since it requires
+ -- performing analysis in two phases: first one
+ -- analyzing discriminants and second analyzing
+ -- the rest of components since discriminants
+ -- are evaluated prior to components: too much
+ -- extra work to detect a corner case???
+
+ if Nkind (Choice) in N_Has_Entity
+ and then Present (Entity (Choice))
+ and then
+ Ekind (Entity (Choice)) = E_Discriminant
+ then
+ null;
+
else
- Comp_Expr := Expression (Assoc);
+ Collect_Expression_Ids (Expr);
end if;
- Collect_Identifiers (Comp_Expr);
- end if;
+ Next (Choice);
+ end loop;
+ end Handle_Association_Choices;
- Next (Choice);
- end loop;
- end if;
+ begin
+ if not Box_Present (Assoc) then
+ if Nkind (Assoc) = N_Component_Association then
+ Handle_Association_Choices
+ (Choices (Assoc), Expression (Assoc));
+
+ elsif
+ Nkind (Assoc) = N_Iterated_Component_Association
+ and then Present (Defining_Identifier (Assoc))
+ then
+ Handle_Association_Choices
+ (Discrete_Choices (Assoc), Expression (Assoc));
+
+ -- Nkind (Assoc) = N_Iterated_Component_Association
+ -- with iterator_specification, or
+ -- Nkind (Assoc) = N_Iterated_Element_Association
+ -- with loop_parameter_specification
+ -- or iterator_specification
+ --
+ -- It seems that we might also need to deal with
+ -- iterable/iterator_names and iterator_filters
+ -- within iterator_specifications, and range bounds
+ -- within loop_parameter_specifications, but the
+ -- utility of doing that seems very low. ???
+
+ else
+ Collect_Expression_Ids (Expression (Assoc));
+ end if;
+ end if;
+ end Handle_Association;
Next (Assoc);
end loop;
