[Ada] Spurious error on overloaded equality in postcondition

This patch fixes a spurious error in a postcondition in a nested
instantiation when the expression includes an inherited equality and
checks are enabled.

2019-07-10  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_res.adb (Resolve_Equality_Op): Do not replace the resolved
	operator by its alias if expander is not active, because the
	operand type may not be frozen yet and its inherited operations
	have not yet been created.

gcc/testsuite/

	* gnat.dg/equal8.adb, gnat.dg/equal8.ads,
	gnat.dg/equal8_pkg.ads: New testcase.

From-SVN: r273327

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 097359309a34cd63b2b1c3a4fbb4470ceb9494ec..762db947835204c7b79fc74fdf01d4e00b658c53 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Equality_Op): Do not replace the resolved
+       operator by its alias if expander is not active, because the
+       operand type may not be frozen yet and its inherited operations
+       have not yet been created.
+
 2019-07-10  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * bindo-elaborators.adb (Elaborate_Units): Set attribute

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index d505bc5ef9830c726bd5b2d0cb2fa2db6acfc420..4f56c53f1cc373364c1ee28bf8c6b915197b1428 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8471,7 +8471,14 @@ package body Sem_Res is
                   Get_Next_Interp (I, It);
                end loop;
 
-               if Present (Alias (Entity (N))) then
+               --  If expansion is active and this is wn inherited operation,
+               --  replace it with its ancestor. This must not be done during
+               --  preanalysis because the type nay not be frozen yet, as when
+               --  the context is a pre/post condition.
+
+               if Present (Alias (Entity (N)))
+                 and then Expander_Active
+               then
                   Set_Entity (N, Alias (Entity (N)));
                end if;
             end;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 430c508d6e13cdd501748503d7b3277341e04612..5c247f16f16d19f5f1f238f7edaaf72747a5fa3b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/equal8.adb, gnat.dg/equal8.ads,
+       gnat.dg/equal8_pkg.ads: New testcase.
+
 2019-07-10  Paolo Carlini  <paolo.carlini@oracle.com>
 
        * g++.dg/diagnostic/complex-invalid-1.C: New.

diff --git a/gcc/testsuite/gnat.dg/equal8.adb b/gcc/testsuite/gnat.dg/equal8.adb
new file mode 100644 (file)
index 0000000..9424abc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal8.adb
@@ -0,0 +1,6 @@
+--  { dg-do compile }
+--  { dg-options "-gnata" }
+
+package body Equal8 is
+   procedure Foo is null;
+end Equal8;

diff --git a/gcc/testsuite/gnat.dg/equal8.ads b/gcc/testsuite/gnat.dg/equal8.ads
new file mode 100644 (file)
index 0000000..9b6694d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal8.ads
@@ -0,0 +1,36 @@
+with Ada.Containers.Formal_Hashed_Sets;
+with Ada.Strings.Hash;
+
+-- with Dynamic_Strings; use Dynamic_Strings;
+-- with Bounded_Dynamic_Strings;
+
+with Equal8_Pkg;
+
+package Equal8 is
+
+   package Dynamic_Strings is
+      --  pragma SPARK_Mode (On);
+
+      package Bounded_Dynamic_Strings is new Equal8_Pkg
+  (Component     => Character,
+   List_Index    => Positive,
+   List          => String,
+   Default_Value => ' ');
+      type Dynamic_String is new Bounded_Dynamic_Strings.Sequence;
+
+   end Dynamic_Strings;
+   use Dynamic_Strings;
+
+   subtype Subscription_Address is Dynamic_String (Capacity => 255);
+
+   function Hashed_Subscription_Address (Element : Subscription_Address)
+      return Ada.Containers.Hash_Type is
+      (Ada.Strings.Hash (Value (Element)));
+
+   package Subscription_Addresses is new Ada.Containers.Formal_Hashed_Sets
+     (Element_Type        => Subscription_Address,
+      Hash                => Hashed_Subscription_Address,
+      Equivalent_Elements => "=");
+
+   procedure Foo;
+end Equal8;

diff --git a/gcc/testsuite/gnat.dg/equal8_pkg.ads b/gcc/testsuite/gnat.dg/equal8_pkg.ads
new file mode 100644 (file)
index 0000000..b454a2c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal8_pkg.ads
@@ -0,0 +1,58 @@
+generic
+   type Component is private;
+   type List_Index is range <>;
+   type List is array (List_Index range <>) of Component;
+   Default_Value : Component;
+ --  with function "=" (Left, Right : List) return Boolean is <>;
+
+package Equal8_Pkg is
+
+   pragma Pure;
+
+   Maximum_Length : constant List_Index := List_Index'Last;
+
+   subtype Natural_Index is List_Index'Base range 0 .. Maximum_Length;
+   type Sequence (Capacity : Natural_Index) is private;
+   --  from zero to Capacity.
+
+   function Value (This : Sequence) return List;
+   --  Returns the content of this sequence. The value returned is the
+   --  "logical" value in that only that slice which is currently assigned
+   --  is returned, as opposed to the entire physical representation.
+
+   overriding
+   function "=" (Left, Right : Sequence) return Boolean with
+     Inline;
+
+   function "=" (Left : Sequence;  Right : List) return Boolean with
+     Inline;
+
+private
+   type Sequence (Capacity : Natural_Index) is record
+      Current_Length : Natural_Index := 0;
+      Content        : List (1 .. Capacity) := (others => Default_Value);
+   end record;
+
+   -----------
+   -- Value --
+   -----------
+
+   function Value (This : Sequence) return List is
+     (This.Content (1 .. This.Current_Length));
+
+   ---------
+   -- "=" --
+   ---------
+
+   overriding
+   function "=" (Left, Right : Sequence) return Boolean is
+     (Value (Left) = Value (Right));
+
+   ---------
+   -- "=" --
+   ---------
+
+   function "=" (Left : Sequence;  Right : List) return Boolean is
+     (Value (Left) = Right);
+end Equal8_Pkg;
+