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 --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1fe5cde0400e872b9f44106252fc7d7f143e93c2..e54351340bdbeadd5c9a3944beeb05591e5bcd21 100644 (file)
--- 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 d209ab09c1f906a46627e25dc3d4c8a767aeb8c7..72288631d3d4457ff2d2f8fad04def3d3cff83ea 100644 (file)
--- 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 f15d5244ba8e2c4c0613c8a86689457fe5f80924..ea3706fe8c7913d6f9ce591eb8a6913b0a9653a6 100644 (file)
--- 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 66145e520544e4fb0479ff98e18caed18a4297a7..fe6f11ff353c879303466bcc9ddbba254cd86331 100644 (file)
--- 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 d25006cb02d8a5849b9fa2f5d36d3c4aea9365b1..9c10406d4b60075368cb95ca8f9aa80d56cf8867 100644 (file)
--- 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 d3ac63a62569144833abf04f5312941068e0bfb7..1722c7caea5d5e7d0bc408aa6b161296078ddc68 100644 (file)
--- 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 bd2d4804c52b30ecd1e5e9ebe5ebc840c266d237..0595bc54fc19ee15d390da983de647627eb937e6 100644 (file)
--- 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 2be3670a3d239238a88f9b4c9fc1d9d4a9ecaaff..5097dbb4aa5dcdd2c82069e30a7fb4745ea633f0 100644 (file)
--- 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 b752a6b1fdc35f99e597a4fec345abf6b8904610..0465975c2c4c51381595a23de903ae5fafc0d1e5 100644 (file)
--- 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 88558a354784c63737d99ebb8a933960804b7283..203c8c7fd3b491657abee1e9bd7c4937fd201afb 100644 (file)
--- 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 cacf29c917fb1903a66d3e9bc0b292b240d53f59..8ee218d0cde842f06da1a8f5434c919d80357dc8 100644 (file)
--- 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 71889b2a25ade4a740187f821c9b0c836686903e..144fcd151bf1a37467377346d6b4833bf4593871 100644 (file)
--- 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 88153accc6612c8e42077432a374fcaaf6d38616..d1fa9c2540dde172e44e6bbf0868a1f553f6ae5d 100644 (file)
--- 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 =>