From: Denis Mazzucato <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 1fe5cde0400..e54351340bd 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 d209ab09c1f..72288631d3d 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 f15d5244ba8..ea3706fe8c7 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 66145e52054..fe6f11ff353 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 d25006cb02d..9c10406d4b6 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 d3ac63a6256..1722c7caea5 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 bd2d4804c52..0595bc54fc1 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 2be3670a3d2..5097dbb4aa5 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 b752a6b1fdc..0465975c2c4 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 88558a35478..203c8c7fd3b 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 cacf29c917f..8ee218d0cde 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 71889b2a25a..144fcd151bf 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 88153accc66..d1fa9c2540d 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 =>
--
2.51.0
