sem_util.adb, [...] (From_Nested_Package): New predicate to determine whether a type...

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1ecb385bc88968f5c17b59538fd178b91a7333b9..6badf78f33772e63a4959f6cccace6a40559524e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <kirtchev@adacore.com>
 
        * sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not consider

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 571f4968a7915e2536be7feee9fa772e81961b9a..5afdc6666e2951bf040ab4db8e5fb6fb79aa6612 100644 (file)
--- 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 6485df20b3b3df29a9c1fd1d8b27d4b71f385140..c80ca5c00bf84b040ebc6487bf5c8252347d4b67 100644 (file)
--- 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 d33a4f9389c49bedf4728ccee26d28e5bf681fae..d2cdf5520b290ff9ca4fad2c5e7496acbdb68a6f 100644 (file)
--- 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 a1787554ac21433526d91b41bbb227934ce66d93..e494f14bc849a97cdebaba763388762318d4372c 100644 (file)
--- 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;