aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2019-07-04 08:06:14 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-04 08:06:14 +0000
commit7cbdab5aa839ffd54dccbde6430905bb9c596201 (patch)
tree6b5e9a1c939ad5eaf09f187539e35fc45920205d /gcc
parent965a269d8bbaca4a96b1327607c9dc42ad9484d4 (diff)
downloadgcc-7cbdab5aa839ffd54dccbde6430905bb9c596201.zip
gcc-7cbdab5aa839ffd54dccbde6430905bb9c596201.tar.gz
gcc-7cbdab5aa839ffd54dccbde6430905bb9c596201.tar.bz2
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/sem_attr.adb5
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/aspect2.adb5
-rw-r--r--gcc/testsuite/gnat.dg/aspect2.ads30
5 files changed, 52 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 34a86ca..be26421 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+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>
* sem_util.adb (Yields_Synchronized_Object): Fix typos in
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bdc76c3..fd2c6d6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1634,7 +1634,9 @@ package body Sem_Attr is
raise Bad_Attribute;
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_Dereference;
@@ -1643,6 +1645,7 @@ package body Sem_Attr is
if not Is_Constrained (P_Type)
and then Is_Entity_Name (P)
and then Is_Type (Entity (P))
+ and then not Is_Current_Instance (P)
then
-- Note: we do not call Error_Attr here, since we prefer to
-- continue, using the relevant index type of the array,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fc041c82..dd22271 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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>
* gnat.dg/synchronized2.adb, gnat.dg/synchronized2.ads,
diff --git a/gcc/testsuite/gnat.dg/aspect2.adb b/gcc/testsuite/gnat.dg/aspect2.adb
new file mode 100644
index 0000000..acf3329
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aspect2.adb
@@ -0,0 +1,5 @@
+-- { dg-do compile }
+
+package body Aspect2 is
+ procedure Foo is null;
+end Aspect2;
diff --git a/gcc/testsuite/gnat.dg/aspect2.ads b/gcc/testsuite/gnat.dg/aspect2.ads
new file mode 100644
index 0000000..73d3fe0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aspect2.ads
@@ -0,0 +1,30 @@
+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;