From: Ed Schonberg Date: Wed, 10 Jul 2019 08:59:55 +0000 (+0000) Subject: [Ada] Spurious error on overloaded equality in postcondition X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ff3ee5e5ef8c91d94a0ff6236a46dc46a670f1c3;p=gcc.git [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 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 097359309a3..762db947835 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-10 Ed Schonberg + + * 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 * bindo-elaborators.adb (Elaborate_Units): Set attribute diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d505bc5ef98..4f56c53f1cc 100644 --- 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 430c508d6e1..5c247f16f16 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-10 Ed Schonberg + + * gnat.dg/equal8.adb, gnat.dg/equal8.ads, + gnat.dg/equal8_pkg.ads: New testcase. + 2019-07-10 Paolo Carlini * 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 index 00000000000..9424abcb8bc --- /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 index 00000000000..9b6694d673a --- /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 index 00000000000..b454a2c5174 --- /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; +