From 8e1e74a162c751014b43d609207aaf75ed4dd428 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Mon, 30 Aug 2021 08:25:50 -0400 Subject: [PATCH] [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. --- gcc/ada/einfo.ads | 8 ++++++++ gcc/ada/gen_il-fields.ads | 1 + gcc/ada/gen_il-gen-gen_entities.adb | 1 + gcc/ada/sem_ch8.adb | 15 +++++++++++++-- 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 2030841eaabc..0239a702659b 100644 --- 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 f8bfe6e0b24c..f3f3ca427032 100644 --- 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 a000d0e70049..1fa7f0b46eec 100644 --- 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 70ad21ccc242..494ec648f46e 100644 --- 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 -- 2.47.2