From 5fe0b8c32cbafad220cfc7668bde71c2cf8d072f Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 25 May 2018 09:03:09 +0000 Subject: [PATCH] [Ada] Refine checks for uplevel references 2018-05-25 Ed Schonberg 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 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/exp_unst.adb | 31 +++++++++++++++++++++++++------ 2 files changed, 34 insertions(+), 6 deletions(-) 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 + + * 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 * 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; -- 2.30.2