https://gcc.gnu.org/g:3b5c0c0f3acf9cab725381484a7c2d0bf65c7456
commit r16-5382-g3b5c0c0f3acf9cab725381484a7c2d0bf65c7456 Author: Denis Mazzucato <[email protected]> Date: Thu Oct 30 12:56:58 2025 +0100 ada: Reserve Is_Constructor for Ada constructors This patch renames old Is_Constructor to a new Is_CPP_Constructor and reserves Is_Constructor for Ada constructors. gcc/ada/ChangeLog: * sem_util.adb (Is_Constructor_Procedure): Replace by Is_Constructor. * sem_util.ads: Likewise. * sem_ch6.adb (Analyze_Direct_Attribute_Definition): Set Is_Constructor. * einfo.ads: Use Is_Constructor for Ada constructors, and Is_CPP_Constructor for CPP constructors. * exp_ch6.adb: Likewise. * exp_disp.adb: Likewise. * freeze.adb: Likewise. * gen_il-fields.ads: Likewise. * gen_il-gen-gen_entities.adb: Likewise. * gen_il-internals.adb: Likewise. * par-ch6.adb: Likewise. * sem_prag.adb: Likewise. * treepr.adb: Likewise. Diff: --- gcc/ada/einfo.ads | 15 ++++++++++----- gcc/ada/exp_ch6.adb | 4 ++-- gcc/ada/exp_disp.adb | 34 +++++++++++++++++----------------- gcc/ada/freeze.adb | 2 +- gcc/ada/gen_il-fields.ads | 1 + gcc/ada/gen_il-gen-gen_entities.adb | 1 + gcc/ada/gen_il-internals.adb | 2 ++ gcc/ada/par-ch6.adb | 5 ++--- gcc/ada/sem_ch6.adb | 1 + gcc/ada/sem_prag.adb | 4 ++-- gcc/ada/sem_util.adb | 26 ++------------------------ gcc/ada/sem_util.ads | 4 ---- gcc/ada/treepr.adb | 2 ++ 13 files changed, 43 insertions(+), 58 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1fe5cde0400e..e54351340bdb 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2537,6 +2537,10 @@ package Einfo is -- and subtypes, string types and subtypes, and all numeric types). -- Set if the type or subtype is constrained. +-- Is_Constructor +-- Defined in procedure entities. Set if a procedure denotes a +-- constructor that allows object initialization via the 'Make attribute. + -- Is_Constr_Array_Subt_With_Bounds -- Defined in all types and subtypes. Set only for an array subtype -- which is constrained but nevertheless requires objects of this @@ -2548,10 +2552,6 @@ package Einfo is -- subtype of an object whose nominal subtype is unconstrained. Note -- that the constructed subtype itself will be constrained. --- Is_Constructor --- Defined in function and procedure entities. Set if a pragma --- CPP_Constructor applies to the subprogram. - -- Is_Controlled_Active [base type only] -- Defined in all type entities. Indicates that the type is controlled, -- i.e. has been declared with the Finalizable or the Destructor aspect @@ -2573,6 +2573,10 @@ package Einfo is -- Defined in all type entities, set only for tagged types to which a -- valid pragma Import (CPP, ...) or pragma CPP_Class has been applied. +-- Is_CPP_Constructor +-- Defined in function and procedure entities. Set if a pragma +-- CPP_Constructor applies to the subprogram. + -- Is_CUDA_Kernel -- Defined in function and procedure entities. Set if the subprogram is a -- CUDA kernel. @@ -5632,7 +5636,7 @@ package Einfo is -- Is_Abstract_Subprogram (non-generic case only) -- Is_Called (non-generic case only) -- Is_Class_Wide_Wrapper - -- Is_Constructor + -- Is_CPP_Constructor -- Is_CUDA_Kernel (non-generic case only) -- Is_DIC_Procedure (non-generic case only) -- Is_Discrim_SO_Function @@ -5994,6 +5998,7 @@ package Einfo is -- Is_Called (non-generic case only) -- Is_Class_Wide_Wrapper -- Is_Constructor + -- Is_CPP_Constructor -- Is_CUDA_Kernel -- Is_Destructor (non-generic case only) -- Is_DIC_Procedure (non-generic case only) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d209ab09c1f9..72288631d3d4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6341,7 +6341,7 @@ package body Exp_Ch6 is begin if not (Nkind (Specification (N)) = N_Procedure_Specification - and then Is_Constructor_Procedure (Spec_Id)) + and then Is_Constructor (Spec_Id)) then return; -- the usual case end if; @@ -10155,7 +10155,7 @@ package body Exp_Ch6 is pragma Assert (Nkind (Allocator) = N_Allocator and then Nkind (Function_Call) = N_Function_Call); pragma Assert (Convention (Function_Id) = Convention_CPP - and then Is_Constructor (Function_Id)); + and then Is_CPP_Constructor (Function_Id)); pragma Assert (Is_Constrained (Underlying_Type (Result_Subt))); -- Replace the initialized allocator of form "new T'(Func (...))" with diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f15d5244ba8e..ea3706fe8c79 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -2332,7 +2332,7 @@ package body Exp_Disp is E := Next_Entity (Typ); while Present (E) loop - if Ekind (E) = E_Function and then Is_Constructor (E) then + if Ekind (E) = E_Function and then Is_CPP_Constructor (E) then return True; end if; @@ -8285,7 +8285,7 @@ package body Exp_Disp is E := Next_Entity (Typ); while Present (E) loop if Ekind (E) = E_Function - and then Is_Constructor (E) + and then Is_CPP_Constructor (E) then Found := True; Loc := Sloc (E); @@ -8307,15 +8307,15 @@ package body Exp_Disp is Defining_Unit_Name => IP, Parameter_Specifications => Parms))); - Set_Init_Proc (Typ, IP); - Set_Is_Imported (IP); - Set_Is_Constructor (IP); - Set_Interface_Name (IP, Interface_Name (E)); - Set_Convention (IP, Convention_CPP); - Set_Is_Public (IP); - Set_Has_Completion (IP); - Mutate_Ekind (IP, E_Procedure); - Freeze_Extra_Formals (IP); + Set_Init_Proc (Typ, IP); + Set_Is_Imported (IP); + Set_Is_CPP_Constructor (IP); + Set_Interface_Name (IP, Interface_Name (E)); + Set_Convention (IP, Convention_CPP); + Set_Is_Public (IP); + Set_Has_Completion (IP); + Mutate_Ekind (IP, E_Procedure); + Freeze_Extra_Formals (IP); -- Case 2: Constructor of a tagged type @@ -8351,12 +8351,12 @@ package body Exp_Disp is Defining_Unit_Name => Constructor_Id, Parameter_Specifications => Parms)); - Set_Is_Imported (Constructor_Id); - Set_Is_Constructor (Constructor_Id); - Set_Interface_Name (Constructor_Id, Interface_Name (E)); - Set_Convention (Constructor_Id, Convention_CPP); - Set_Is_Public (Constructor_Id); - Set_Has_Completion (Constructor_Id); + Set_Is_Imported (Constructor_Id); + Set_Is_CPP_Constructor (Constructor_Id); + Set_Interface_Name (Constructor_Id, Interface_Name (E)); + Set_Convention (Constructor_Id, Convention_CPP); + Set_Is_Public (Constructor_Id); + Set_Has_Completion (Constructor_Id); -- Build the init procedure as a wrapper of this constructor diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 66145e520544..fe6f11ff353c 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -10490,7 +10490,7 @@ package body Freeze is -- For C++ constructors check that their external name has been given -- (either in pragma CPP_Constructor or in a pragma import). - if Is_Constructor (E) + if Is_CPP_Constructor (E) and then Convention (E) = Convention_CPP and then (No (Interface_Name (E)) diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index d25006cb02d8..9c10406d4b60 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -700,6 +700,7 @@ package Gen_IL.Fields is Is_Controlled_Active, Is_Controlling_Formal, Is_CPP_Class, + Is_CPP_Constructor, Is_CUDA_Kernel, Is_Descendant_Of_Address, Is_Destructor, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index d3ac63a62569..1722c7caea5d 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -137,6 +137,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Constructor, Flag), Sm (Is_Controlled_Active, Flag, Base_Type_Only), Sm (Is_CPP_Class, Flag), + Sm (Is_CPP_Constructor, Flag), Sm (Is_Descendant_Of_Address, Flag), Sm (Is_Discrim_SO_Function, Flag), Sm (Is_Discriminant_Check_Function, Flag), diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb index bd2d4804c52b..0595bc54fc19 100644 --- a/gcc/ada/gen_il-internals.adb +++ b/gcc/ada/gen_il-internals.adb @@ -297,6 +297,8 @@ package body Gen_IL.Internals is return "Ignore_SPARK_Mode_Pragmas"; when Is_CPP_Class => return "Is_CPP_Class"; + when Is_CPP_Constructor => + return "Is_CPP_Constructor"; when Is_CUDA_Kernel => return "Is_CUDA_Kernel"; when Is_DIC_Procedure => diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 2be3670a3d23..5097dbb4aa5d 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -233,9 +233,8 @@ package body Ch6 is then -- Note that, this workaround is needed to retain the info that -- the current subprogram comes from a direct attribute - -- definition. Otherwise, we would need to add an entity flag - -- Is_Constructor. Currently this flag already exists and could be - -- misleading as it refer to CPP constructors ??? + -- definition. Otherwise, we would need to add an entity flag like + -- Is_Direct_Attribute_Definition ??? Copy_Spec := New_Copy (Spec); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b752a6b1fdc3..0465975c2c4c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5354,6 +5354,7 @@ package body Sem_Ch6 is else Set_Needs_Construction (Prefix_E); + Set_Is_Constructor (Designator); end if; when others => diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 88558a354784..203c8c7fd3b4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16587,7 +16587,7 @@ package body Sem_Prag is -- Check if already defined as constructor - if Is_Constructor (Def_Id) then + if Is_CPP_Constructor (Def_Id) then Error_Msg_N ("??duplicate argument for pragma 'C'P'P_Constructor", Arg1); return; @@ -16612,7 +16612,7 @@ package body Sem_Prag is end if; Set_Has_Completion (Def_Id); - Set_Is_Constructor (Def_Id); + Set_Is_CPP_Constructor (Def_Id); Set_Convention (Def_Id, Convention_CPP); -- Imported C++ constructors are not dispatching primitives diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cacf29c917fb..8ee218d0cde8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11863,7 +11863,7 @@ package body Sem_Util is Cursor := Get_Name_Entity_Id (Direct_Attribute_Definition_Name (Typ, Name_Constructor)); while Present (Cursor) loop - if Is_Constructor_Procedure (Cursor) + if Is_Constructor (Cursor) and then No (Next_Formal (First_Formal (Cursor))) then return True; @@ -16720,28 +16720,6 @@ package body Sem_Util is end if; end Is_Constant_Bound; - ------------------------------ - -- Is_Constructor_Procedure -- - ------------------------------ - - function Is_Constructor_Procedure (Subp : Entity_Id) return Boolean is - First_Param : Entity_Id; - begin - if not (Present (First_Formal (Subp)) - and then Ekind (First_Formal (Subp)) = E_In_Out_Parameter - and then Is_Direct_Attribute_Subp_Spec (Parent (Subp)) - and then Attribute_Name (Defining_Unit_Name - (Original_Node (Parent (Subp)))) - = Name_Constructor) - then - return False; - end if; - - First_Param := Implementation_Base_Type (Etype (First_Formal (Subp))); - return Scope (Subp) = Scope (First_Param) - and then Needs_Construction (First_Param); - end Is_Constructor_Procedure; - --------------------------- -- Is_Container_Element -- --------------------------- @@ -17009,7 +16987,7 @@ package body Sem_Util is return Present (Ret_Typ) and then Is_CPP_Class (Ret_Typ) - and then Is_Constructor (Entity (Name (N))) + and then Is_CPP_Constructor (Entity (Name (N))) and then Is_Imported (Entity (Name (N))); end Is_CPP_Constructor_Call; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 71889b2a25ad..144fcd151bf1 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1921,10 +1921,6 @@ package Sem_Util is -- enumeration literal, or an expression composed of constant-bound -- subexpressions which are evaluated by means of standard operators. - function Is_Constructor_Procedure (Subp : Entity_Id) return Boolean; - -- Returns True if Subp's name directly references an attribute, has a - -- first in out formal that needs construction within the same scope. - function Is_Container_Element (Exp : Node_Id) return Boolean; -- This routine recognizes expressions that denote an element of one of -- the predefined containers, when the source only contains an indexing diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 88153accc661..d1fa9c2540dd 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -331,6 +331,8 @@ package body Treepr is return "Ignore_SPARK_Mode_Pragmas"; when F_Is_CPP_Class => return "Is_CPP_Class"; + when F_Is_CPP_Constructor => + return "Is_CPP_Constructor"; when F_Is_CUDA_Kernel => return "Is_CUDA_Kernel"; when F_Is_DIC_Procedure =>
