Commit 2bbc7940 by Ed Schonberg Committed by Pierre-Marie de Rodat

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

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
parent 17d65c91
2018-07-17 Ed Schonberg <schonberg@adacore.com>
* 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 <schonberg@adacore.com>
* exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not
active. Don't use Get_Actual_Subtype for record subtypes. Ignore
rewritten identifiers and uplevel references to bounds of types that
......
......@@ -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);
......
2018-07-17 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/equal3.adb: New testcase.
2018-07-17 Justin Squirek <squirek@adacore.com>
* gnat.dg/split_args.adb: New testcase.
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment