From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 12 Aug 2019 09:00:59 +0000 (+0000)
Subject: [Ada] Improper error message on equality op with different operand types
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6ab24ed7528b0375c49e4416f825a90bdca63454;p=gcc.git

[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 351cc490152..3c22a90a21a 100644
--- 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 25ee7053ade..3c026bf43b9 100644
--- 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 2918943d1aa..ee519d4c21b 100644
--- 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
index 00000000000..9b61e5ed7e1
--- /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
index 00000000000..28e1a2183c8
--- /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;