This patch fixes a spurious error in a postcondition in a nested
instantiation when the expression includes an inherited equality and
checks are enabled.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-10 Ed Schonberg <schonb...@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.--- gcc/ada/sem_res.adb
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
+
