1 files changed, 29 insertions, 24 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 26fdcfa..b3546c6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -601,30 +601,35 @@ package body Sem_Attr is
 
             Build_Access_Subprogram_Type (P);
 
-            --  For unrestricted access, kill current values, since this
-            --  attribute allows a reference to a local subprogram that
-            --  could modify local variables to be passed out of scope
-
-            if Aname = Name_Unrestricted_Access then
-
-               --  Do not kill values on nodes initializing dispatch tables
-               --  slots. The construct Prim_Ptr!(Prim'Unrestricted_Access)
-               --  is currently generated by the expander only for this
-               --  purpose. Done to keep the quality of warnings currently
-               --  generated by the compiler (otherwise any declaration of
-               --  a tagged type cleans constant indications from its scope).
-
-               if Nkind (Parent (N)) = N_Unchecked_Type_Conversion
-                 and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr)
-                             or else
-                           Etype (Parent (N)) = RTE (RE_Size_Ptr))
-                 and then Is_Dispatching_Operation
-                            (Directly_Designated_Type (Etype (N)))
-               then
-                  null;
-               else
-                  Kill_Current_Values;
-               end if;
+            --  For P'Access or P'Unrestricted_Access, where P is a nested
+            --  subprogram, we might be passing P to another subprogram (but we
+            --  don't check that here), which might call P. P could modify
+            --  local variables, so we need to kill current values. It is
+            --  important not to do this for library-level subprograms, because
+            --  Kill_Current_Values is very inefficient in the case of library
+            --  level packages with lots of tagged types.
+
+            if Is_Library_Level_Entity (Entity (Prefix (N))) then
+               null;
+
+            --  Do not kill values on nodes initializing dispatch tables
+            --  slots. The construct Prim_Ptr!(Prim'Unrestricted_Access)
+            --  is currently generated by the expander only for this
+            --  purpose. Done to keep the quality of warnings currently
+            --  generated by the compiler (otherwise any declaration of
+            --  a tagged type cleans constant indications from its scope).
+
+            elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion
+              and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr)
+                          or else
+                        Etype (Parent (N)) = RTE (RE_Size_Ptr))
+              and then Is_Dispatching_Operation
+                         (Directly_Designated_Type (Etype (N)))
+            then
+               null;
+
+            else
+               Kill_Current_Values;
             end if;
 
             return;