[Ada] Improper error message on equality op with different operand types

2019-08-12  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined
	equality has the same profile as the predefined equality before
	applying legality rule in RM 4.5.2 (9.8).

gcc/testsuite/

	* gnat.dg/equal10.adb, gnat.dg/equal10.ads: New testcase.

From-SVN: r274297

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 351cc49..3c22a90 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-12  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined
+       equality has the same profile as the predefined equality before
+       applying legality rule in RM 4.5.2 (9.8).
+
 2019-08-12  Bob Duff  <duff@adacore.com>
 
        * libgnat/a-except.ads: Update obsolete comment, still making

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 25ee705..3c026bf 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8420,11 +8420,12 @@ package body Sem_Ch6 is
 
    begin
       --  This check applies only if we have a subprogram declaration with an
-      --  untagged record type.
+      --  untagged record type that is conformant to the predefined op.
 
       if Nkind (Decl) /= N_Subprogram_Declaration
         or else not Is_Record_Type (Typ)
         or else Is_Tagged_Type (Typ)
+        or else Etype (Next_Formal (First_Formal (Eq_Op))) /= Typ
       then
          return;
       end if;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2918943..ee519d4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-12  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/equal10.adb, gnat.dg/equal10.ads: New testcase.
+
 2019-08-12  Gary Dismukes  <dismukes@adacore.com>
 
        * gnat.dg/suppress_initialization2.adb,

diff --git a/gcc/testsuite/gnat.dg/equal10.adb b/gcc/testsuite/gnat.dg/equal10.adb
new file mode 100644 (file)
index 0000000..9b61e5e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal10.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Equal10 is
+  procedure Dummy is null;
+end Equal10;

diff --git a/gcc/testsuite/gnat.dg/equal10.ads b/gcc/testsuite/gnat.dg/equal10.ads
new file mode 100644 (file)
index 0000000..28e1a21
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal10.ads
@@ -0,0 +1,7 @@
+package Equal10 is
+  type R is record X : Integer; end record;
+  Rr : R;
+  function "=" (Y : R; Z : Integer) return Boolean is
+     (Y.X = Z);
+  procedure Dummy;
+end Equal10;