https://gcc.gnu.org/g:881cb10e96d8753bede46aba145e228c236382d1
commit r17-1633-g881cb10e96d8753bede46aba145e228c236382d1 Author: Javier Miranda <[email protected]> Date: Tue May 26 16:06:49 2026 +0000 ada: Improve error reported for wrong constructor call This patch improves the error reported when the invoked constructor is not available. This is a common error because constructors are not inherited; this means that a constructor for a given tagged type may not exist for its derived types. Fix also a crash in the initialization of a limited record type. gcc/ada/ChangeLog: * sem_attr.adb (Analyze_Attribute): Report an error when the number of actual parameters for a constructor do not match any available constructor. * exp_ch6.adb (Make_Init_Proc_Call): Add the _Init_Level accessibility level formal when building a call to the init proc of a limited record type. (Prepend_Constructor_Procedure_Prologue): Restrict the initialization of the _parent component to cases where a Super aspect is present or a parameterless parent constructor exists. Diff: --- gcc/ada/exp_ch6.adb | 14 +++++++++++++ gcc/ada/sem_attr.adb | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6a322be004ff..f25c46213bb0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6043,6 +6043,17 @@ package body Exp_Ch6 is Append (Make_Mode_Literal (Loc, Full_Init), Params); end if; + -- The init proc for a limited record type has an extra + -- accessibility level formal (_Init_Level) that must be + -- passed. + + if Present (Init_Proc_Level_Formal (Init_Proc)) then + Append + (Make_Integer_Literal + (Loc, Scope_Depth (Standard_Standard)), + Params); + end if; + return Init_Proc_Call : constant Node_Id := Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (Init_Proc, Loc), @@ -6189,6 +6200,9 @@ package body Exp_Ch6 is elsif Chars (Component) = Name_uParent and then Needs_Construction (Etype (Component)) + and then (Present (Find_Aspect (Body_Id, Aspect_Super)) + or else Has_Parameterless_Constructor + (Etype (Component))) then Append_To (Parent_List, Make_Parent_Constructor_Call diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7a2154f18f49..77a61fff801b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5430,6 +5430,62 @@ package body Sem_Attr is if not Needs_Construction (Entity (P)) then Error_Msg_NE ("no available constructor for&", N, Entity (P)); + + -- Verify that the provided arguments are compatible with at least + -- one constructor (checked by parameters count). Mismatched + -- actuals will be caught later during resolution. + + elsif not Is_Copy_Constructor_Call (N) + and then Comes_From_Source (N) + then + declare + Num_Args : constant Nat := List_Length (Exprs); + + function Is_Candidate + (Constructor_Id : Entity_Id) return Boolean; + -- Determine whether Num_Args is between the minimum and + -- maximum number of actuals required to invoke this + -- constructor. + + ------------------ + -- Is_Candidate -- + ------------------ + + function Is_Candidate + (Constructor_Id : Entity_Id) return Boolean + is + Formal : Entity_Id; + Max_Actuals : Nat := 0; + Min_Actuals : Nat := 0; + + begin + Formal := Next_Formal (First_Formal (Constructor_Id)); + while Present (Formal) loop + Max_Actuals := Max_Actuals + 1; + + if No (Default_Value (Formal)) then + Min_Actuals := Min_Actuals + 1; + end if; + + Next_Formal (Formal); + end loop; + + return Num_Args in Min_Actuals .. Max_Actuals; + end Is_Candidate; + + function Find_Candidate is + new Find_Matching_Constructor (Is_Candidate); + + begin + if No (Find_Candidate + (Typ => Entity (P), + Allow_Removed => False)) + then + Error_Msg_NE + ("no constructor matching given arguments for&", + N, Entity (P)); + end if; + end; end if; elsif not Needs_Construction (Entity (P))
