Commit 7cbdab5a by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Spurious error on 'First in a generic context

This patch fixes a spurious error on an attribute reference within an
aspect specification for an unconstrained array type when the
corresponding type  declaration appears within a generic unit.

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

gcc/ada/

	* sem_attr.adb (Check_Array_Type): An array type attribute such
	as 'First can be applied to an unconstrained array tyope when
	the attribute reference appears within an aspect specification
	and the prefix is a current instance, given that the prefix of
	the attribute will become a formal of the subprogram that
	implements the aspect (typically a predicate check).

gcc/testsuite/

	* gnat.dg/aspect2.adb, gnat.dg/aspect2.ads: New testcase.

From-SVN: r273058
parent 965a269d
2019-07-04 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Check_Array_Type): An array type attribute such
as 'First can be applied to an unconstrained array tyope when
the attribute reference appears within an aspect specification
and the prefix is a current instance, given that the prefix of
the attribute will become a formal of the subprogram that
implements the aspect (typically a predicate check).
2019-07-04 Piotr Trojanek <trojanek@adacore.com> 2019-07-04 Piotr Trojanek <trojanek@adacore.com>
* sem_util.adb (Yields_Synchronized_Object): Fix typos in * sem_util.adb (Yields_Synchronized_Object): Fix typos in
......
...@@ -1634,7 +1634,9 @@ package body Sem_Attr is ...@@ -1634,7 +1634,9 @@ package body Sem_Attr is
raise Bad_Attribute; raise Bad_Attribute;
end if; end if;
-- Normal case of array type or subtype -- Normal case of array type or subtype. Note that if the
-- prefix is a current instance of a type declaration it
-- appears within an aspect specification and is legal.
Check_Either_E0_Or_E1; Check_Either_E0_Or_E1;
Check_Dereference; Check_Dereference;
...@@ -1643,6 +1645,7 @@ package body Sem_Attr is ...@@ -1643,6 +1645,7 @@ package body Sem_Attr is
if not Is_Constrained (P_Type) if not Is_Constrained (P_Type)
and then Is_Entity_Name (P) and then Is_Entity_Name (P)
and then Is_Type (Entity (P)) and then Is_Type (Entity (P))
and then not Is_Current_Instance (P)
then then
-- Note: we do not call Error_Attr here, since we prefer to -- Note: we do not call Error_Attr here, since we prefer to
-- continue, using the relevant index type of the array, -- continue, using the relevant index type of the array,
......
2019-07-04 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/aspect2.adb, gnat.dg/aspect2.ads: New testcase.
2019-07-04 Yannick Moy <moy@adacore.com> 2019-07-04 Yannick Moy <moy@adacore.com>
* gnat.dg/synchronized2.adb, gnat.dg/synchronized2.ads, * gnat.dg/synchronized2.adb, gnat.dg/synchronized2.ads,
......
-- { dg-do compile }
package body Aspect2 is
procedure Foo is null;
end Aspect2;
with Ada.Containers.Functional_Vectors;
with Ada.Containers; use Ada.Containers;
generic
type Element_Type (<>) is private;
type Element_Model (<>) is private;
with function Model (X : Element_Type) return Element_Model is <>;
with function Copy (X : Element_Type) return Element_Type is <>;
package Aspect2 with SPARK_Mode is
pragma Unevaluated_Use_Of_Old (Allow);
type Vector is private;
function Length (V : Vector) return Natural;
procedure Foo;
private
type Element_Access is access Element_Type;
type Element_Array is array (Positive range <>) of Element_Access with
Dynamic_Predicate => Element_Array'First = 1;
type Element_Array_Access is access Element_Array;
type Vector is record
Top : Natural := 0;
Content : Element_Array_Access;
end record;
function Length (V : Vector) return Natural is
(V.Top);
end Aspect2;
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