[Ada] Fix latent problem in Sem_Ch8.Build_Class_Wide_Wrapper

gcc/ada/

	* sem_ch8.adb (Build_Class_Wide_Wrapper): Fix handling of
	class-wide subtypes; required to handle chains of
	instantiations. Adding also code to identify these wrappers and
	properly resolve instantiations where the wrapper and a tagged
	type primitive are visible.
	* einfo.ads (Is_Class_Wide_Wrapper): Adding documentation.
	* gen_il-fields.ads (Opt_Field_Enum): Adding
	Is_Class_Wide_Wrapper.
	* gen_il-gen-gen_entities.adb (Root_Entity_Type): Adding
	semantic flag Is_Class_Wide_Wrapper.

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 2030841eaabc61f2e6d56d6eb28a241b9e4c5ff6..0239a702659b3b746eaeac243f45049256724690 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2429,6 +2429,11 @@ package Einfo is
 --    Is_Class_Wide_Type (synthesized)
 --       Applies to all entities, true for class wide types and subtypes
 
+--    Is_Class_Wide_Wrapper
+--       Defined in subprogram entities. Indicates that it has been created as
+--       a wrapper in a generic/instance scenario involving a formal type and
+--       a generic primitive operation when the actual is a class-wide type.
+
 --    Is_Compilation_Unit
 --       Defined in all entities. Set if the entity is a package or subprogram
 --       entity for a compilation unit other than a subunit (since we treat
@@ -5562,6 +5567,7 @@ package Einfo is
    --    Ignore_SPARK_Mode_Pragmas
    --    Is_Abstract_Subprogram               (non-generic case only)
    --    Is_Called                            (non-generic case only)
+   --    Is_Class_Wide_Wrapper
    --    Is_Constructor
    --    Is_CUDA_Kernel                       (non-generic case only)
    --    Is_DIC_Procedure                     (non-generic case only)
@@ -5734,6 +5740,7 @@ package Einfo is
    --    Default_Expressions_Processed
    --    Has_Nested_Subprogram
    --    Ignore_SPARK_Mode_Pragmas
+   --    Is_Class_Wide_Wrapper
    --    Is_Elaboration_Checks_OK_Id
    --    Is_Elaboration_Warnings_OK_Id
    --    Is_Intrinsic_Subprogram
@@ -5924,6 +5931,7 @@ package Einfo is
    --    Is_Abstract_Subprogram               (non-generic case only)
    --    Is_Asynchronous
    --    Is_Called                            (non-generic case only)
+   --    Is_Class_Wide_Wrapper
    --    Is_Constructor
    --    Is_CUDA_Kernel
    --    Is_DIC_Procedure                     (non-generic case only)

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index f8bfe6e0b24c09f245d719c7baf47628d3303ede..f3f3ca42703252e9215347f971d39098699695aa 100644 (file)
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -680,6 +680,7 @@ package Gen_IL.Fields is
       Is_Checked_Ghost_Entity,
       Is_Child_Unit,
       Is_Class_Wide_Equivalent_Type,
+      Is_Class_Wide_Wrapper,
       Is_Compilation_Unit,
       Is_Completely_Hidden,
       Is_Concurrent_Record_Type,

diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index a000d0e7004931e3c3709c3336e43c98f8c8e330..1fa7f0b46eecdcfec9bc15996c4f7f88790ad3f6 100644 (file)
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -126,6 +126,7 @@ begin -- Gen_IL.Gen.Gen_Entities
         Sm (Is_Character_Type, Flag),
         Sm (Is_Checked_Ghost_Entity, Flag),
         Sm (Is_Child_Unit, Flag),
+        Sm (Is_Class_Wide_Wrapper, Flag),
         Sm (Is_Class_Wide_Equivalent_Type, Flag),
         Sm (Is_Compilation_Unit, Flag),
         Sm (Is_Concurrent_Record_Type, Flag),

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 70ad21ccc242197f5f86f87b408b134959d9a0da..494ec648f46e838b33fd23c019efd18f96b40550 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2539,8 +2539,8 @@ package body Sem_Ch8 is
               and then Is_Class_Wide_Type (Get_Instance_Of (Etype (Formal)))
             then
                Formal_Typ := Etype (Formal);
-               Actual_Typ := Get_Instance_Of (Formal_Typ);
-               Root_Typ   := Etype (Actual_Typ);
+               Actual_Typ := Base_Type (Get_Instance_Of (Formal_Typ));
+               Root_Typ   := Root_Type (Actual_Typ);
                exit;
             end if;
 
@@ -2590,6 +2590,15 @@ package body Sem_Ch8 is
             elsif CW_Prim_Op = Root_Prim_Op then
                Prim_Op := Root_Prim_Op;
 
+            --  The two subprograms are legal but the class-wide subprogram is
+            --  a class-wide wrapper built for a previous instantiation; the
+            --  wrapper has precedence.
+
+            elsif Present (Alias (CW_Prim_Op))
+              and then Is_Class_Wide_Wrapper (Ultimate_Alias (CW_Prim_Op))
+            then
+               Prim_Op := CW_Prim_Op;
+
             --  Otherwise both candidate subprograms are user-defined and
             --  ambiguous.
 
@@ -2688,6 +2697,8 @@ package body Sem_Ch8 is
             Set_Corresponding_Body (Spec_Decl, Defining_Entity (Body_Decl));
          end if;
 
+         Set_Is_Class_Wide_Wrapper (Wrap_Id);
+
          --  If the operator carries an Eliminated pragma, indicate that the
          --  wrapper is also to be eliminated, to prevent spurious error when
          --  using gnatelim on programs that include box-initialization of