]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Plug small loophole in the handling of private views in instances
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 12 Jun 2023 07:52:42 +0000 (09:52 +0200)
committerMarc Poulhiès <poulhies@adacore.com>
Tue, 27 Jun 2023 12:05:50 +0000 (14:05 +0200)
This deals with nested instantiations in package bodies.

gcc/ada/

* sem_ch12.adb (Scope_Within_Body_Or_Same): New predicate.
(Check_Actual_Type): Take into account packages nested in bodies
to compute the enclosing scope by means of
Scope_Within_Body_Or_Same.

gcc/ada/sem_ch12.adb

index fbfc2db7f9a2254a12a1ef8c889c64a43db279a2..43fcff2c9d5c2210b303f30d5ddd92ea570907b8 100644 (file)
@@ -7001,11 +7001,11 @@ package body Sem_Ch12 is
       --  The enclosing scope of the generic unit
 
       procedure Check_Actual_Type (Typ : Entity_Id);
-      --  If the type of the actual is a private type declared in the
-      --  enclosing scope of the generic unit, but not a derived type
-      --  of a private type declared elsewhere, the body of the generic
-      --  sees the full view of the type (because it has to appear in
-      --  the corresponding package body). If the type is private now,
+      --  If the type of the actual is a private type declared in the enclosing
+      --  scope of the generic, either directly or through packages nested in
+      --  bodies, but not a derived type of a private type declared elsewhere,
+      --  then the body of the generic sees the full view of the type because
+      --  it has to appear in the package body. If the type is private now then
       --  exchange views to restore the proper visibility in the instance.
 
       -----------------------
@@ -7015,16 +7015,48 @@ package body Sem_Ch12 is
       procedure Check_Actual_Type (Typ : Entity_Id) is
          Btyp : constant Entity_Id := Base_Type (Typ);
 
+         function Scope_Within_Body_Or_Same
+           (Inner : Entity_Id;
+            Outer : Entity_Id) return Boolean;
+         --  Determine whether scope Inner is within the body of scope Outer
+         --  or is Outer itself.
+
+         -------------------------------
+         -- Scope_Within_Body_Or_Same --
+         -------------------------------
+
+         function Scope_Within_Body_Or_Same
+           (Inner : Entity_Id;
+            Outer : Entity_Id) return Boolean
+         is
+            Curr : Entity_Id := Inner;
+
+         begin
+            while Curr /= Standard_Standard loop
+               if Curr = Outer then
+                  return True;
+
+               elsif Is_Package_Body_Entity (Curr) then
+                  Curr := Scope (Curr);
+
+               else
+                  exit;
+               end if;
+            end loop;
+
+            return False;
+         end Scope_Within_Body_Or_Same;
+
       begin
          --  The exchange is only needed if the generic is defined
          --  within a package which is not a common ancestor of the
          --  scope of the instance, and is not already in scope.
 
          if Is_Private_Type (Btyp)
-           and then Scope (Btyp) = Parent_Scope
            and then not Has_Private_Ancestor (Btyp)
            and then Ekind (Parent_Scope) in E_Package | E_Generic_Package
-           and then Scope (Instance) /= Parent_Scope
+           and then Scope_Within_Body_Or_Same (Parent_Scope, Scope (Btyp))
+           and then Parent_Scope /= Scope (Instance)
            and then not Is_Child_Unit (Gen_Id)
          then
             Switch_View (Btyp);