Aspect_Stream_Size => Expression,
Aspect_String_Literal => Name,
Aspect_Subprogram_Variant => Expression,
- Aspect_Super => Expression,
+ Aspect_Super => Optional_Expression,
Aspect_Suppress => Name,
Aspect_Synchronization => Name,
Aspect_Test_Case => Expression,
-- It also supplies the source location used for the procedure.
procedure Build_Implicit_Copy_Constructor (N : Node_Id; Typ : Entity_Id);
- -- Build default copy constructor. N is the type declaration node, and Typ
+ -- Build implicit copy constructor. N is the type declaration node, and Typ
-- is the corresponding entity for the record type.
+ procedure Build_Implicit_Parameterless_Constructor
+ (N : Node_Id; Typ : Entity_Id);
+ -- Build implicit parameterless constructor. N is the type declaration
+ -- node, and Typ is the corresponding entity for the record type.
+
function Build_Discriminant_Formals
(Rec_Id : Entity_Id;
Use_Dl : Boolean) return List_Id;
Set_Init_Proc (Typ, Copy_Id);
end Build_Implicit_Copy_Constructor;
+ ----------------------------------------------
+ -- Build_Implicit_Parameterless_Constructor --
+ ----------------------------------------------
+
+ procedure Build_Implicit_Parameterless_Constructor
+ (N : Node_Id; Typ : Entity_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Constructor_Id : Entity_Id;
+ Spec_Node : Node_Id;
+ begin
+ -- The implicit parameterless constructor doesn't need to do anything.
+ -- In fact, during subprogram expansion, prepending the prologue of
+ -- constructors takes care of calling the parent's constructor (if
+ -- derived) and initializing components that need construction. Exactly
+ -- what an implicit parameterless constructor should do.
+
+ if not Comes_From_Source (N)
+ or else not Needs_Construction (Typ)
+ or else Has_Parameterless_Constructor (Typ, Allow_Removed => True)
+ or else Has_Explicit_Constructor (Typ)
+ or else (Is_Derived_Type (Typ)
+ and then not Has_Parameterless_Constructor
+ (Parent_Subtype (Typ)))
+ then
+ return;
+ end if;
+
+ Constructor_Id :=
+ Make_Defining_Identifier (Loc,
+ Direct_Attribute_Definition_Name (Typ, Name_Constructor));
+ Mutate_Ekind (Constructor_Id, E_Procedure);
+
+ if not Debug_Generated_Code then
+ Set_Debug_Info_Off (Constructor_Id);
+ end if;
+
+ Spec_Node := New_Node (N_Procedure_Specification, Loc);
+ Set_Defining_Unit_Name (Spec_Node, Constructor_Id);
+
+ -- The implicit parameterless constructor has the following profile:
+ -- procedure T'Constructor (Self : in out T);
+
+ Set_Parameter_Specifications (Spec_Node, New_List (
+ Make_Parameter_Specification (Loc,
+ Defining_Identifier => Make_Defining_Identifier (Loc, Name_Self),
+ In_Present => True,
+ Out_Present => True,
+ Parameter_Type => New_Occurrence_Of (Typ, Loc))));
+
+ Freeze_Extra_Formals (Constructor_Id);
+
+ declare
+ Ignore : Node_Id;
+ begin
+ Ignore :=
+ Make_Subprogram_Body (Loc,
+ Specification => Spec_Node,
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc));
+ end;
+
+ Set_Is_Public (Constructor_Id, Is_Public (Typ));
+ Set_Is_Internal (Constructor_Id);
+ Set_Is_Constructor (Constructor_Id);
+ Set_Init_Proc (Typ, Constructor_Id);
+ end Build_Implicit_Parameterless_Constructor;
+
--------------------------------
-- Build_Discriminant_Formals --
--------------------------------
Build_Untagged_Record_Equality (Typ);
end if;
- -- Freeze constructors as predefined operations
-
- Append_Freeze_Actions (Typ, Constructor_Freeze (Typ));
-
-- Before building the record initialization procedure, if we are
-- dealing with a concurrent record value type, then we must go through
-- the discriminants, exchanging discriminals between the concurrent
and then (Tagged_Type_Expansion or else not Is_Interface (Typ))
then
Build_Record_Init_Proc (Typ_Decl, Typ);
+ Build_Implicit_Parameterless_Constructor (Typ_Decl, Typ);
Build_Implicit_Copy_Constructor (Typ_Decl, Typ);
end if;
+ -- Freeze constructors as done with predefined operations
+
+ Append_Freeze_Actions (Typ, Constructor_Freeze (Typ));
+
-- Create the body of TSS primitive Finalize_Address. This must be done
-- before the bodies of all predefined primitives are created. If Typ
-- is limited, Stream_Input and Stream_Read may produce build-in-place
Next (Initialize_Comp_Assoc);
end loop;
+ -- If a default expression is present in the record
+ -- declaration, then use it.
+
if Present (Expression (Parent (Component))) then
return Expression (Parent (Component));
end if;
+ -- In case the type needs construction and a parameterless
+ -- constructor is present, then it can be implicitly used it
+ -- here.
+
+ if Needs_Construction (Etype (Component))
+ and then Has_Parameterless_Constructor (Etype (Component))
+ then
+ return Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Etype (Component), Loc),
+ Attribute_Name => Name_Make);
+ end if;
+
return Empty;
end Init_Expression_If_Any;
Expression (Super_Aspect);
Expr : Node_Id;
begin
- if Nkind (Super_Expr) /= N_Aggregate then
+ -- Super without expression is a call to the parent
+ -- parameterless constructor.
+
+ if No (Super_Expr) then
+ Actual_Parameters := No_List;
+
+ elsif Nkind (Super_Expr) /= N_Aggregate then
Expr := New_Copy_Tree (Super_Expr);
Set_Paren_Count (Expr, 0);
Actual_Parameters := New_List (Expr);
+
else
-- Interpret this "aggregate" as a list of
-- actual parameter expressions.
end if;
if Chars (Component) = Name_uTag then
- null;
+ Append_To (Init_List,
+ Make_Tag_Assignment_From_Type (Loc,
+ Target => New_Occurrence_Of
+ (First_Formal (Spec_Id), Loc),
+ Typ => First_Param_Type));
elsif Chars (Component) = Name_uParent
and then Needs_Construction (Etype (Component))
Error_Msg_N ("Super must apply to a constructor body", N);
end if;
- -- handle missing parameter list (an error case)
+ -- Without parameter list, the parent parameterless
+ -- constructor is called, nothing more to do here.
- if No (Expr) then
- Error_Msg_N ("constructor parameters required", N);
+ if Present (Expr) then
- -- Handle parameter list of length more than one
- -- (such a list is parsed as an aggregate).
+ -- Handle parameter list of length more than one
+ -- (such a list is parsed as an aggregate).
- elsif Nkind (Expr) = N_Aggregate then
- if Present (Component_Associations (Expr))
- or else No (Expressions (Expr))
- then
- Error_Msg_N
- ("malformed constructor parameter list", N);
+ if Nkind (Expr) = N_Aggregate then
+ if Present (Component_Associations (Expr))
+ or else No (Expressions (Expr))
+ then
+ Error_Msg_N
+ ("malformed constructor parameter list", N);
- elsif Analyze_Parameter_Expressions then
- declare
- Param_Expr : Node_Id := First (Expressions (Expr));
- begin
- while Present (Param_Expr) loop
- Analyze (Param_Expr);
- Check_Super_Arg (Param_Expr);
- Next (Param_Expr);
- end loop;
+ elsif Analyze_Parameter_Expressions then
+ declare
+ Param_Expr : Node_Id :=
+ First (Expressions (Expr));
+ begin
+ while Present (Param_Expr) loop
+ Analyze (Param_Expr);
+ Check_Super_Arg (Param_Expr);
+ Next (Param_Expr);
+ end loop;
- Set_Analyzed (Expr);
- -- Someday Vast may complain that this so-called
- -- aggregate has no Etype. For now, we mark it
- -- as analyzed and hope that nobody trips over it.
- end;
- end if;
+ Set_Analyzed (Expr);
+ -- Someday Vast may complain that this so-called
+ -- aggregate has no Etype. For now, we mark it
+ -- as analyzed and hope that nobody trips over
+ -- it.
+ end;
+ end if;
- -- handle parameter list of length one
+ -- handle parameter list of length one
- elsif Paren_Count (Expr) = 0 then
- Error_Msg_N
- ("parentheses missing for constructor parameter list ",
- N);
+ elsif Paren_Count (Expr) = 0 then
+ Error_Msg_N
+ ("parentheses missing for constructor parameter " &
+ "list ",
+ N);
- elsif Analyze_Parameter_Expressions then
- Analyze (Expr);
- Check_Super_Arg (Expr);
+ elsif Analyze_Parameter_Expressions then
+ Analyze (Expr);
+ Check_Super_Arg (Expr);
+ end if;
end if;
end Super;
and then Nkind (E) = N_Aggregate
then
Act_T := Etype (E);
-
- elsif Needs_Construction (T)
- and then not Has_Init_Expression (N)
- and then not Has_Parameterless_Constructor (T)
- and then not Suppress_Initialization (Id)
- and then Comes_From_Source (N)
- then
- Error_Msg_NE ("no parameterless constructor for&",
- Object_Definition (N), T);
end if;
-- Check No_Wide_Characters restriction
projects / thirdparty / gcc.git / commitdiff
