* [Ada] Spurious error on predicate of local private type.
@ 2017-04-25 13:57 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2017-04-25 13:57 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 1119 bytes --]
This patch fixes a spurious error on a predicate specification for a type
declared in a local package, when an object declaration that references that
type appears outside of the package.
The following must compile quietly:
---
procedure Pred_Scope is
package P is
Local : Boolean := False;
type T is private with Dynamic_Predicate => Local;
subtype T2 is Integer range 1 .. 10 with Dynamic_Predicate => Local;
private
type T is new Integer;
end;
Dummy1 : P.T;
Dummy2 : P.T2;
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 4940 bytes --]
Index: freeze.adb
===================================================================
--- freeze.adb (revision 247212)
+++ freeze.adb (working copy)
@@ -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 @@
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 @@
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;
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 247228)
+++ sem_ch13.adb (working copy)
@@ -1188,10 +1188,7 @@
-- 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 @@
end if;
End_Package_Scope (Pack);
+ return;
end;
else
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 247221)
+++ sem_util.adb (working copy)
@@ -7575,6 +7575,19 @@
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 --
-----------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 247212)
+++ sem_util.ads (working copy)
@@ -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 @@
-- - "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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2017-04-25 13:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-04-25 13:57 [Ada] Spurious error on predicate of local private type Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).