From 25409c3c63b151f27bd77fb92c8b62af8681d777 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 25 May 2018 09:05:04 +0000 Subject: [PATCH] [Ada] Membership test of class-wide interface The compiler rejects the use of a membership test when the left operand is a class-wide interface type object and the right operand is not a class-wide type. 2018-05-25 Javier Miranda gcc/ada/ * sem_res.adb (Resolve_Membership_Op): Allow the use of the membership test when the left operand is a class-wide interface and the right operand is not a class-wide type. * exp_ch4.adb (Tagged_Membership): Adding support for interface as the left operand. gcc/testsuite/ * gnat.dg/interface7.adb: New testcase. From-SVN: r260738 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/exp_ch4.adb | 2 +- gcc/ada/sem_res.adb | 1 - gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/interface7.adb | 16 ++++++++++++++++ 5 files changed, 29 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/interface7.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dfe117a..d20be7e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2018-05-25 Javier Miranda + + * sem_res.adb (Resolve_Membership_Op): Allow the use of the membership + test when the left operand is a class-wide interface and the right + operand is not a class-wide type. + * exp_ch4.adb (Tagged_Membership): Adding support for interface as the + left operand. + 2018-05-25 Ed Schonberg * exp_aggr.adb (Flatten): A quantified expression cannot be duplicated diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 3378580..65de38e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -13891,7 +13891,7 @@ package body Exp_Ch4 is Selector_Name => New_Occurrence_Of (First_Tag_Component (Left_Type), Loc)); - if Is_Class_Wide_Type (Right_Type) then + if Is_Class_Wide_Type (Right_Type) or else Is_Interface (Left_Type) then -- No need to issue a run-time check if we statically know that the -- result of this membership test is always true. For example, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 6329d92..a71e583 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9032,7 +9032,6 @@ package body Sem_Res is elsif Ada_Version >= Ada_2005 and then Is_Class_Wide_Type (Etype (L)) and then Is_Interface (Etype (L)) - and then Is_Class_Wide_Type (Etype (R)) and then not Is_Interface (Etype (R)) then return; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b48eaec..821a12d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-25 Javier Miranda + + * gnat.dg/interface7.adb: New testcase. + 2018-05-25 Hristian Kirtchev * gnat.dg/sec_stack2.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/interface7.adb b/gcc/testsuite/gnat.dg/interface7.adb new file mode 100644 index 0000000..90417fe --- /dev/null +++ b/gcc/testsuite/gnat.dg/interface7.adb @@ -0,0 +1,16 @@ +-- { dg-do compile } + +procedure Interface7 is + type I_Type is interface; + + type A1_Type is tagged null record; + type A2_Type is new A1_Type and I_Type with null record; + + procedure Test (X : I_Type'Class) is + begin + if X in A2_Type then -- Test + null; + end if; + end Test; + +begin null; end; -- 2.7.4