From: Javier Miranda <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 6a322be004f..f25c46213bb 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 7a2154f18f4..77a61fff801 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))
--
2.53.0
