From: Ed Schonberg <schonberg@adacore.com>
Date: Fri, 25 May 2018 09:03:09 +0000 (+0000)
Subject: [Ada] Refine checks for uplevel references
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5fe0b8c32cbafad220cfc7668bde71c2cf8d072f;p=gcc.git

[Ada] Refine checks for uplevel references

2018-05-25  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node): Restrict check for uplevel references in
	prefixes of array attributes, to prefixes that are entity names whose
	type is constrained.
	(Note_Uplevel_Bound): Verify that the bound is declared in an enclosing
	subprogram, as itype created for loops in pre/postcondition may appear
	in loops at the library level.

From-SVN: r260717
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 104dbdc722f..a4730773bcb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-05-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_unst.adb (Visit_Node): Restrict check for uplevel references in
+	prefixes of array attributes, to prefixes that are entity names whose
+	type is constrained.
+	(Note_Uplevel_Bound): Verify that the bound is declared in an enclosing
+	subprogram, as itype created for loops in pre/postcondition may appear
+	in loops at the library level.
+
 2018-05-25  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch13.adb (Build_Predicate_Functions): The predicate function
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 0e60c4998b5..ec4539a9841 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -401,9 +401,14 @@ package body Exp_Unst is
                procedure Note_Uplevel_Bound (N : Node_Id) is
                begin
                   --  Entity name case
+                  --  Make sure that that the entity is declared in a
+                  --  subprogram. THis may not be the case for an type
+                  --  in a loop appearing in a precondition.
 
                   if Is_Entity_Name (N) then
-                     if Present (Entity (N)) then
+                     if Present (Entity (N))
+                        and then Present (Enclosing_Subprogram (Entity (N)))
+                     then
                         Note_Uplevel_Ref
                           (E      => Entity (N),
                            Caller => Current_Subprogram,
@@ -616,11 +621,25 @@ package body Exp_Unst is
                         | Attribute_Last
                         | Attribute_Length
                      =>
-                        declare
-                           DT : Boolean := False;
-                        begin
-                           Check_Static_Type (Etype (Prefix (N)), DT);
-                        end;
+                        --  Special-case attributes of array objects
+                        --  whose bounds may be uplevel references.
+                        --  More complex prefixes are handled during
+                        --  full traversal. Note that if the nominal
+                        --  subtype of the prefix is unconstrained, the
+                        --  bound must be obtained from the object, not
+                        --  from the (possibly) uplevel reference,
+
+                        if Is_Entity_Name (Prefix (N))
+                          and then Is_Constrained (Etype (Prefix (N)))
+                        then
+                           declare
+                              DT : Boolean := False;
+                           begin
+                              Check_Static_Type (Etype (Prefix (N)), DT);
+                           end;
+
+                           return OK;
+                        end if;
 
                      when others =>
                         null;