[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  <miranda@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dfe117ad9c592148b6c0b3f0b58036c5d362c7de..d20be7e484cf37165e82e921080eae4216370cca 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2018-05-25  Javier Miranda  <miranda@adacore.com>
+
+       * 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  <schonberg@adacore.com>
 
        * 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 3378580740edb662538285504038cc7b0b567da6..65de38e9e8332948e351a71accfb378e29d7c680 100644 (file)
--- 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 6329d92fd72616c213783c33d438fd681dc7913f..a71e5830ef5f8dfabd19a21c79338884574376bb 100644 (file)
--- 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 b48eaec980c1f829390527d74bbe5d807aedd17a..821a12dc6ce6fbfcd1c1fde9692c33bd2a28297e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-25  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/interface7.adb: New testcase.
+
 2018-05-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * 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 (file)
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;