https://gcc.gnu.org/g:7e8feb008589bc482b8f0e5bfbf9e4598587206c
commit r17-722-g7e8feb008589bc482b8f0e5bfbf9e4598587206c Author: Denis Mazzucato <[email protected]> Date: Tue Jan 6 13:38:49 2026 +0100 ada: Support for implicit parameterless constructor An implicit parameterless constructor is available when no other constructor is declared for a tagged type that has an ancestor with constructors. The implicit parameterless constructor calls the parent parameterless constructor through the Super aspect without arguments. gcc/ada/ChangeLog: * aspects.ads (Aspects): Make Super aspect optional to allow for explicit call to parent parameterless constructor. * exp_ch3.adb (Build_Implicit_Parameterless_Constructor): Build implicit parameterless constructor when no other constructors are defined but the type has an ancestor with constructors. * exp_ch6.adb (Init_Expression_If_Any): Pe4rmit implicit calls to parameterless constructors in initialization expressions if available. (Make_Parent_Constructor_Call): Super without parameters calls the parent parameterless constructor. * sem_ch13.adb (Analyze_Aspect_Specification): Allow Super aspect without expression. * sem_ch3.adb (Analyze_Object_Declaration): Delay check for missing parameterless constructor until the the implicit constructor is built. Diff: --- gcc/ada/aspects.ads | 2 +- gcc/ada/exp_ch3.adb | 84 ++++++++++++++++++++++++++++++++++++++++++++++++---- gcc/ada/exp_ch6.adb | 31 +++++++++++++++++-- gcc/ada/sem_ch13.adb | 72 +++++++++++++++++++++++--------------------- gcc/ada/sem_ch3.adb | 9 ------ 5 files changed, 147 insertions(+), 51 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 9e01abf233fc..7b127751ec0f 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -524,7 +524,7 @@ package Aspects is 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, diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 13cf7bad88c4..3aa86247f146 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -95,9 +95,14 @@ package body Exp_Ch3 is -- 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; @@ -1982,6 +1987,74 @@ package body Exp_Ch3 is 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 -- -------------------------------- @@ -6583,10 +6656,6 @@ package body Exp_Ch3 is 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 @@ -6631,9 +6700,14 @@ package body Exp_Ch3 is 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 diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 70b5a66ed13d..8b5e0e4bb984 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6409,10 +6409,26 @@ package body Exp_Ch6 is 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; @@ -6466,10 +6482,17 @@ package body Exp_Ch6 is 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. @@ -6509,7 +6532,11 @@ package body Exp_Ch6 is 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)) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c3cdeeff59bc..c72fd6bd8b5b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5346,48 +5346,52 @@ package body Sem_Ch13 is 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 63ae1147a4fd..b222679f77c7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5249,15 +5249,6 @@ package body Sem_Ch3 is 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
