From 2bbc7940969ba1840d103c3f0c6af2de2e67c514 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 17 Jul 2018 08:09:14 +0000 Subject: [PATCH] [Ada] Missing check on illegal equality operation in subprogram In Ada2012 it is illegal to declare an equality operation on an untagged type when the operation is primitive and the type is already frozem (see RM 4.5.2 (9.8)). previously the test to detect this illegality only examined declarations within a package. This patch covers the case where type and operation are both declared within a subprogram body. 2018-07-17 Ed Schonberg gcc/ada/ * sem_ch6.adb (Check_Untagged_Equality): Extend check to operations declared in the same scope as the operand type, when that scope is a procedure. gcc/testsuite/ * gnat.dg/equal3.adb: New testcase. From-SVN: r262788 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch6.adb | 19 +++++++++++-------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/equal3.adb | 22 ++++++++++++++++++++++ 4 files changed, 43 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/equal3.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e7845675d93..fd02931bf5c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-17 Ed Schonberg + + * sem_ch6.adb (Check_Untagged_Equality): Extend check to operations + declared in the same scope as the operand type, when that scope is a + procedure. + 2018-07-17 Ed Schonberg * exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 08717bf0a23..2dd9d2f4287 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8581,14 +8581,10 @@ package body Sem_Ch6 is if Is_Frozen (Typ) then - -- If the type is not declared in a package, or if we are in the body - -- of the package or in some other scope, the new operation is not - -- primitive, and therefore legal, though suspicious. Should we - -- generate a warning in this case ??? + -- The check applies to a primitive operation, so check that type + -- and equality operation are in the same scope. - if Ekind (Scope (Typ)) /= E_Package - or else Scope (Typ) /= Current_Scope - then + if Scope (Typ) /= Current_Scope then return; -- If the type is a generic actual (sub)type, the operation is not @@ -8631,7 +8627,7 @@ package body Sem_Ch6 is ("\move declaration to package spec (Ada 2012)?y?", Eq_Op); end if; - -- Otherwise try to find the freezing point + -- Otherwise try to find the freezing point for better message. else Obj_Decl := Next (Parent (Typ)); @@ -8659,6 +8655,13 @@ package body Sem_Ch6 is end if; exit; + + -- If we reach generated code for subprogram declaration + -- or body, it is the body that froze the type and the + -- declaration is legal. + + elsif Sloc (Obj_Decl) = Sloc (Decl) then + return; end if; Next (Obj_Decl); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index eace53c3b35..2c2f1e3684b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-07-17 Ed Schonberg + + * gnat.dg/equal3.adb: New testcase. + 2018-07-17 Justin Squirek * gnat.dg/split_args.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/equal3.adb b/gcc/testsuite/gnat.dg/equal3.adb new file mode 100644 index 00000000000..2e4bba6472f --- /dev/null +++ b/gcc/testsuite/gnat.dg/equal3.adb @@ -0,0 +1,22 @@ +-- { dg-do compile } + +procedure Equal3 is + type R is record + A, B : Integer; + end record; + + package Pack is + type RR is record + C : R; + end record; + + X : RR := (C => (A => 1, B => 1)); + Y : RR := (C => (A => 1, B => 2)); + pragma Assert (X /= Y); --@ASSERT:PASS + + end Pack; + use Pack; + function "=" (X, Y : R) return Boolean is (X.A = Y.A); -- { dg-error "equality operator must be declared before type \"R\" is frozen \\(RM 4.5.2 \\(9.8\\)\\) \\(Ada 2012\\)" } +begin + pragma Assert (X /= Y); --@ASSERT:FAIL +end Equal3; -- 2.30.2