Commit ff3ee5e5 by Ed Schonberg Committed by Pierre-Marie de Rodat

[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
parent 19448640
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
......
......@@ -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;
......
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.
......
-- { dg-do compile }
-- { dg-options "-gnata" }
package body Equal8 is
procedure Foo is null;
end Equal8;
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;
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;
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