[Ada] Wrong evaluation of membership test

The code generated by the compiler erroneously evaluates to True
membership tests when their left operand is a a class-wide interface
object and the right operand is a tagged type that implements such
interface type.

2019-07-08  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch4.adb (Tagged_Membership): Fix regression silently
	introduced in r260738 that erroneouslusy causes the evaluation
	to True of the membership test when the left operand of the
	membership test is a class-wide interface object and the right
	operand is a type that implements such interface type.

gcc/testsuite/

	* gnat.dg/interface10.adb: New testcase.

From-SVN: r273219

gcc/ada/ChangeLog

+2019-07-08  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch4.adb (Tagged_Membership): Fix regression silently
+	introduced in r260738 that erroneouslusy causes the evaluation
+	to True of the membership test when the left operand of the
+	membership test is a class-wide interface object and the right
+	operand is a type that implements such interface type.
+
 2019-07-08  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not

gcc/ada/exp_ch4.adb

@@ -14156,7 +14156,8 @@ package body Exp_Ch4 is
          --    Obj1 in DT'Class;     --  Compile time error
          --    Obj1 in Iface'Class;  --  Compile time error
 
-         if not Is_Class_Wide_Type (Left_Type)
+         if not Is_Interface (Left_Type)
+           and then not Is_Class_Wide_Type (Left_Type)
            and then (Is_Ancestor (Etype (Right_Type), Left_Type,
                                   Use_Full_View => True)
                       or else (Is_Interface (Etype (Right_Type))

gcc/testsuite/ChangeLog

+2019-07-08  Javier Miranda  <miranda@adacore.com>
+
+	* gnat.dg/interface10.adb: New testcase.
+
 2019-07-08  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/addr13.adb, gnat.dg/addr13.ads: New testcase.

gcc/testsuite/gnat.dg/interface10.adb

+--  { dg-do run }
+--  { dg-options "-gnata" }
+
+with Ada.Text_IO;
+
+procedure Interface10 is
+
+   type Iface is interface;
+
+   type My_First_Type is new Iface with null record;
+   type My_Second_Type is new Iface with null record;
+
+   procedure Do_Test (Object : in Iface'Class) is
+   begin
+      pragma Assert
+        ((Object in My_First_Type) = (Object in My_First_Type'Class));
+   end;
+
+   V : My_Second_Type;
+begin
+   Do_Test (V);
+end Interface10;