+ ---------------------------------
+ -- Resolve_Container_Aggregate --
+ ---------------------------------
+
+ procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is
+ procedure Resolve_Iterated_Association
+ (Comp : Node_Id;
+ Key_Type : Entity_Id;
+ Elmt_Type : Entity_Id);
+ -- Resolve choices and expression in an iterated component association
+ -- or an iterated element association, which has a key_expression.
+ -- This is similar but not identical to the handling of this construct
+ -- in an array aggregate.
+ -- For a named container, the type of each choice must be compatible
+ -- with the key type. For a positional container, the choice must be
+ -- a subtype indication or an iterator specification that determines
+ -- an element type.
+
+ Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
+
+ Empty_Subp : Node_Id := Empty;
+ Add_Named_Subp : Node_Id := Empty;
+ Add_Unnamed_Subp : Node_Id := Empty;
+ New_Indexed_Subp : Node_Id := Empty;
+ Assign_Indexed_Subp : Node_Id := Empty;
+
+ ----------------------------------
+ -- Resolve_Iterated_Association --
+ ----------------------------------
+
+ procedure Resolve_Iterated_Association
+ (Comp : Node_Id;
+ Key_Type : Entity_Id;
+ Elmt_Type : Entity_Id)
+ is
+ Choice : Node_Id;
+ Ent : Entity_Id;
+ Expr : Node_Id;
+ Key_Expr : Node_Id;
+ Id : Entity_Id;
+ Id_Name : Name_Id;
+ Iter : Node_Id;
+ Typ : Entity_Id := Empty;
+
+ begin
+ -- If this is an Iterated_Element_Association then either a
+ -- an Iterator_Specification or a Loop_Parameter specification
+ -- is present. In both cases a Key_Expression is present.
+
+ if Nkind (Comp) = N_Iterated_Element_Association then
+ if Present (Loop_Parameter_Specification (Comp)) then
+ Analyze_Loop_Parameter_Specification
+ (Loop_Parameter_Specification (Comp));
+ Id_Name := Chars (Defining_Identifier
+ (Loop_Parameter_Specification (Comp)));
+ else
+ Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+ Analyze (Iter);
+ Typ := Etype (Defining_Identifier (Iter));
+ Id_Name := Chars (Defining_Identifier
+ (Iterator_Specification (Comp)));
+ end if;
+
+ -- Key expression must have the type of the key. We analyze
+ -- a copy of the original expression, because it will be
+ -- reanalyzed and copied as needed during expansion of the
+ -- corresponding loop.
+
+ Key_Expr := Key_Expression (Comp);
+ Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+
+ elsif Present (Iterator_Specification (Comp)) then
+ Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+ Id_Name := Chars (Defining_Identifier (Comp));
+ Analyze (Iter);
+ Typ := Etype (Defining_Identifier (Iter));
+
+ else
+ Choice := First (Discrete_Choices (Comp));
+
+ while Present (Choice) loop
+ Analyze (Choice);
+
+ -- Choice can be a subtype name, a range, or an expression
+
+ if Is_Entity_Name (Choice)
+ and then Is_Type (Entity (Choice))
+ and then Base_Type (Entity (Choice)) = Base_Type (Key_Type)
+ then
+ null;
+
+ elsif Present (Key_Type) then
+ Analyze_And_Resolve (Choice, Key_Type);
+
+ else
+ Typ := Etype (Choice); -- assume unique for now
+ end if;
+
+ Next (Choice);
+ end loop;
+
+ Id_Name := Chars (Defining_Identifier (Comp));
+ end if;
+
+ -- Create a scope in which to introduce an index, which is usually
+ -- visible in the expression for the component, and needed for its
+ -- analysis.
+
+ Id := Make_Defining_Identifier (Sloc (Comp), Id_Name);
+ Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L');
+ Set_Etype (Ent, Standard_Void_Type);
+ Set_Parent (Ent, Parent (Comp));
+ Push_Scope (Ent);
+
+ -- Insert and decorate the loop variable in the current scope.
+ -- The expression has to be analyzed once the loop variable is
+ -- directly visible. Mark the variable as referenced to prevent
+ -- spurious warnings, given that subsequent uses of its name in the
+ -- expression will reference the internal (synonym) loop variable.
+
+ Enter_Name (Id);
+
+ if No (Key_Type) then
+ pragma Assert (Present (Typ));
+ Set_Etype (Id, Typ);
+ else
+ Set_Etype (Id, Key_Type);
+ end if;
+
+ Set_Ekind (Id, E_Variable);
+ Set_Scope (Id, Ent);
+ Set_Referenced (Id);
+
+ -- Analyze a copy of the expression, to verify legality. We use
+ -- a copy because the expression will be analyzed anew when the
+ -- enclosing aggregate is expanded, and the construct is rewritten
+ -- as a loop with a new index variable.
+
+ Expr := New_Copy_Tree (Expression (Comp));
+ Preanalyze_And_Resolve (Expr, Elmt_Type);
+ End_Scope;
+
+ end Resolve_Iterated_Association;
+
+ begin
+ pragma Assert (Nkind (Asp) = N_Aggregate);
+
+ Set_Etype (N, Typ);
+ Parse_Aspect_Aggregate (Asp,
+ Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
+ New_Indexed_Subp, Assign_Indexed_Subp);
+
+ if Present (Add_Unnamed_Subp)
+ and then No (New_Indexed_Subp)
+ then
+ declare
+ Elmt_Type : constant Entity_Id :=
+ Etype (Next_Formal
+ (First_Formal (Entity (Add_Unnamed_Subp))));
+ Comp : Node_Id;
+
+ begin
+ if Present (Expressions (N)) then
+ -- positional aggregate
+
+ Comp := First (Expressions (N));
+ while Present (Comp) loop
+ Analyze_And_Resolve (Comp, Elmt_Type);
+ Next (Comp);
+ end loop;
+ end if;
+
+ -- Empty aggregate, to be replaced by Empty during
+ -- expansion, or iterated component association.
+
+ if Present (Component_Associations (N)) then
+ declare
+ Comp : Node_Id := First (Component_Associations (N));
+ begin
+ while Present (Comp) loop
+ if Nkind (Comp) /=
+ N_Iterated_Component_Association
+ then
+ Error_Msg_N ("illegal component association "
+ & "for unnamed container aggregate", Comp);
+ return;
+ else
+ Resolve_Iterated_Association
+ (Comp, Empty, Elmt_Type);
+ end if;
+
+ Next (Comp);
+ end loop;
+ end;
+ end if;
+ end;
+
+ elsif Present (Add_Named_Subp) then
+ declare
+ -- Retrieves types of container, key, and element from the
+ -- specified insertion procedure.
+
+ Container : constant Entity_Id :=
+ First_Formal (Entity (Add_Named_Subp));
+ Key_Type : constant Entity_Id := Etype (Next_Formal (Container));
+ Elmt_Type : constant Entity_Id :=
+ Etype (Next_Formal (Next_Formal (Container)));
+ Comp : Node_Id;
+ Choice : Node_Id;
+
+ begin
+ Comp := First (Component_Associations (N));
+ while Present (Comp) loop
+ if Nkind (Comp) = N_Component_Association then
+ Choice := First (Choices (Comp));
+
+ while Present (Choice) loop
+ Analyze_And_Resolve (Choice, Key_Type);
+ if not Is_Static_Expression (Choice) then
+ Error_Msg_N ("Choice must be static", Choice);
+ end if;
+
+ Next (Choice);
+ end loop;
+
+ Analyze_And_Resolve (Expression (Comp), Elmt_Type);
+
+ elsif Nkind (Comp) in
+ N_Iterated_Component_Association |
+ N_Iterated_Element_Association
+ then
+ Resolve_Iterated_Association
+ (Comp, Key_Type, Elmt_Type);
+ end if;
+
+ Next (Comp);
+ end loop;
+ end;
+
+ else
+ -- Indexed Aggregate. Positional or indexed component
+ -- can be present, but not both. Choices must be static
+ -- values or ranges with static bounds.
+
+ declare
+ Container : constant Entity_Id :=
+ First_Formal (Entity (Assign_Indexed_Subp));
+ Index_Type : constant Entity_Id := Etype (Next_Formal (Container));
+ Comp_Type : constant Entity_Id :=
+ Etype (Next_Formal (Next_Formal (Container)));
+ Comp : Node_Id;
+ Choice : Node_Id;
+
+ begin
+ if Present (Expressions (N)) then
+ Comp := First (Expressions (N));
+ while Present (Comp) loop
+ Analyze_And_Resolve (Comp, Comp_Type);
+ Next (Comp);
+ end loop;
+ end if;
+
+ if Present (Component_Associations (N)) then
+ if Present (Expressions (N)) then
+ Error_Msg_N ("Container aggregate cannot be "
+ & "both positional and named", N);
+ return;
+ end if;
+
+ Comp := First (Expressions (N));
+
+ while Present (Comp) loop
+ if Nkind (Comp) = N_Component_Association then
+ Choice := First (Choices (Comp));
+
+ while Present (Choice) loop
+ Analyze_And_Resolve (Choice, Index_Type);
+ Next (Choice);
+ end loop;
+
+ Analyze_And_Resolve (Expression (Comp), Comp_Type);
+
+ elsif Nkind (Comp) in
+ N_Iterated_Component_Association |
+ N_Iterated_Element_Association
+ then
+ Resolve_Iterated_Association
+ (Comp, Index_Type, Comp_Type);
+ end if;
+
+ Next (Comp);
+ end loop;
+ end if;
+ end;
+ end if;
+ end Resolve_Container_Aggregate;
+