From e1691d7e604001acf559885a0db261eaef0dc5d8 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 25 Apr 2017 13:28:14 +0000 Subject: [PATCH] sem_util.adb, [...] (From_Nested_Package): New predicate to determine whether a type is declared in a local package that... 2017-04-25 Ed Schonberg * sem_util.adb, sem_util.ads (From_Nested_Package): New predicate to determine whether a type is declared in a local package that has not yet been frozen. * freeze.adb (Freeze_Before): Use new predicate to determine whether a local package must be installed on the scope stack in order to evaluate in the proper scope actions generated by aspect specifications, such as Predicate * sem_ch13.adb: Simplify code in Analyze_Aspects_At_Freeze_Point using new predicate. From-SVN: r247229 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/freeze.adb | 21 +++++++++++++++++++-- gcc/ada/sem_ch13.adb | 6 ++---- gcc/ada/sem_util.adb | 13 +++++++++++++ gcc/ada/sem_util.ads | 9 ++++++++- 5 files changed, 54 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1ecb385bc88..6badf78f337 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-04-25 Ed Schonberg + + * sem_util.adb, sem_util.ads (From_Nested_Package): New predicate + to determine whether a type is declared in a local package that + has not yet been frozen. + * freeze.adb (Freeze_Before): Use new predicate to determine + whether a local package must be installed on the scope stack + in order to evaluate in the proper scope actions generated by + aspect specifications, such as Predicate + * sem_ch13.adb: Simplify code in Analyze_Aspects_At_Freeze_Point + using new predicate. + 2017-04-25 Hristian Kirtchev * sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not consider diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 571f4968a79..5afdc6666e2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2108,6 +2108,7 @@ package body Freeze is Freeze_Nodes : constant List_Id := Freeze_Entity (T, N, Do_Freeze_Profile); + Pack : constant Entity_Id := Scope (T); begin if Ekind (T) = E_Function then @@ -2115,7 +2116,23 @@ package body Freeze is end if; if Is_Non_Empty_List (Freeze_Nodes) then - Insert_Actions (N, Freeze_Nodes); + + -- If the entity is a type declared in an inner package, it may be + -- frozen by an outer declaration before the package itself is + -- frozen. Install the package scope to analyze the freeze nodes, + -- which may include generated subprograms such as predicate + -- functions, etc. + + if Is_Type (T) and then From_Nested_Package (T) then + Push_Scope (Pack); + Install_Visible_Declarations (Pack); + Install_Private_Declarations (Pack); + Insert_Actions (N, Freeze_Nodes); + End_Package_Scope (Pack); + + else + Insert_Actions (N, Freeze_Nodes); + end if; end if; end Freeze_Before; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6485df20b3b..c80ca5c00bf 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1188,10 +1188,7 @@ package body Sem_Ch13 is -- itself is frozen the type will have been frozen as well. if not Scope_Within_Or_Same (Current_Scope, Scope (E)) then - if Is_Type (E) - and then Ekind (Scope (E)) = E_Package - and then not Is_Frozen (Scope (E)) - then + if Is_Type (E) and then From_Nested_Package (E) then declare Pack : constant Entity_Id := Scope (E); @@ -1208,6 +1205,7 @@ package body Sem_Ch13 is end if; End_Package_Scope (Pack); + return; end; else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d33a4f9389c..d2cdf5520b2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7575,6 +7575,19 @@ package body Sem_Util is return Res (Res'First .. Res_Index - 1); end Fix_Msg; + ------------------------- + -- From_Nested_Package -- + ------------------------- + + function From_Nested_Package (T : Entity_Id) return Boolean is + Pack : constant Entity_Id := Scope (T); + begin + return Ekind (Pack) = E_Package + and then not Is_Frozen (Pack) + and then not Scope_Within_Or_Same (Current_Scope, Pack) + and then In_Open_Scopes (Scope (Pack)); + end From_Nested_Package; + ----------------------- -- Gather_Components -- ----------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a1787554ac2..e494f14bc84 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -819,6 +819,13 @@ package Sem_Util is -- - "task" when Id is a single task object, task type or task body -- All other non-matching words remain as is + function From_Nested_Package (T : Entity_Id) return Boolean; + -- A type declared in a nested package may be frozen by a declaration + -- appearing after the package but before the package is frozen. If the + -- type has aspects that generate subprograms, these may contain references + -- to entities local to the nested package. In that case the package must + -- be installed on the scope stack to prevent spurious visibility errors. + procedure Gather_Components (Typ : Entity_Id; Comp_List : Node_Id; -- 2.30.2