+ end Build_Back_End_Aggregate;
+
+ ----------------------------------------
+ -- Compile_Time_Known_Composite_Value --
+ ----------------------------------------
+
+ function Compile_Time_Known_Composite_Value
+ (N : Node_Id) return Boolean
+ is
+ begin
+ -- If we have an entity name, then see if it is the name of a
+ -- constant and if so, test the corresponding constant value.
+
+ if Is_Entity_Name (N) then
+ declare
+ E : constant Entity_Id := Entity (N);
+ V : Node_Id;
+ begin
+ if Ekind (E) /= E_Constant then
+ return False;
+ else
+ V := Constant_Value (E);
+ return Present (V)
+ and then Compile_Time_Known_Composite_Value (V);
+ end if;
+ end;
+
+ -- We have a value, see if it is compile time known
+
+ else
+ if Nkind (N) = N_Aggregate then
+ return Compile_Time_Known_Aggregate (N);
+ end if;
+
+ -- All other types of values are not known at compile time
+
+ return False;
+ end if;
+
+ end Compile_Time_Known_Composite_Value;
+
+ ----------------------------------
+ -- Component_Not_OK_For_Backend --
+ ----------------------------------
+
+ function Component_Not_OK_For_Backend return Boolean is
+ C : Node_Id;
+ Expr_Q : Node_Id;
+
+ begin
+ if No (Comps) then
+ return False;
+ end if;
+
+ C := First (Comps);
+ while Present (C) loop
+
+ -- If the component has box initialization, expansion is needed
+ -- and component is not ready for backend.
+
+ if Box_Present (C) then
+ return True;
+ end if;
+
+ if Nkind (Expression (C)) = N_Qualified_Expression then
+ Expr_Q := Expression (Expression (C));
+ else
+ Expr_Q := Expression (C);
+ end if;
+
+ -- Return true if the aggregate has any associations for tagged
+ -- components that may require tag adjustment.
+
+ -- These are cases where the source expression may have a tag that
+ -- could differ from the component tag (e.g., can occur for type
+ -- conversions and formal parameters). (Tag adjustment not needed
+ -- if Tagged_Type_Expansion because object tags are implicit in
+ -- the machine.)
+
+ if Is_Tagged_Type (Etype (Expr_Q))
+ and then (Nkind (Expr_Q) = N_Type_Conversion
+ or else (Is_Entity_Name (Expr_Q)
+ and then
+ Ekind (Entity (Expr_Q)) in Formal_Kind))
+ and then Tagged_Type_Expansion
+ then
+ Static_Components := False;
+ return True;
+
+ elsif Is_Delayed_Aggregate (Expr_Q) then
+ Static_Components := False;
+ return True;
+
+ elsif Possible_Bit_Aligned_Component (Expr_Q) then
+ Static_Components := False;
+ return True;
+
+ elsif Modify_Tree_For_C
+ and then Nkind (C) = N_Component_Association
+ and then Has_Per_Object_Constraint (Choices (C))
+ then
+ Static_Components := False;
+ return True;
+
+ elsif Modify_Tree_For_C
+ and then Nkind (Expr_Q) = N_Identifier
+ and then Is_Array_Type (Etype (Expr_Q))
+ then
+ Static_Components := False;
+ return True;
+ end if;
+
+ if Is_Elementary_Type (Etype (Expr_Q)) then
+ if not Compile_Time_Known_Value (Expr_Q) then
+ Static_Components := False;
+ end if;
+
+ elsif not Compile_Time_Known_Composite_Value (Expr_Q) then
+ Static_Components := False;
+
+ if Is_Private_Type (Etype (Expr_Q))
+ and then Has_Discriminants (Etype (Expr_Q))
+ then
+ return True;
+ end if;
+ end if;
+
+ Next (C);
+ end loop;
+
+ return False;
+ end Component_Not_OK_For_Backend;
+
+ -------------------------------
+ -- Has_Per_Object_Constraint --
+ -------------------------------
+
+ function Has_Per_Object_Constraint (L : List_Id) return Boolean is
+ N : Node_Id := First (L);
+ begin
+ while Present (N) loop
+ if Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then Has_Per_Object_Constraint (Entity (N))
+ then
+ return True;
+ end if;
+
+ Next (N);
+ end loop;
+
+ return False;
+ end Has_Per_Object_Constraint;
+
+ -----------------------------------
+ -- Has_Visible_Private_Ancestor --
+ -----------------------------------
+
+ function Has_Visible_Private_Ancestor (Id : E) return Boolean is
+ R : constant Entity_Id := Root_Type (Id);
+ T1 : Entity_Id := Id;
+
+ begin
+ loop
+ if Is_Private_Type (T1) then
+ return True;
+
+ elsif T1 = R then
+ return False;
+
+ else
+ T1 := Etype (T1);
+ end if;
+ end loop;
+ end Has_Visible_Private_Ancestor;