This patch fixes a visibility error on a subtype of a derived private type,
when the enclosing unit is both the parent of an instantiated generic child
unit, and contains an expression function that is automatically inlined.
The following must compile and execute quietly:
gnatmake -q main
main
with p2.child1;
procedure Main is
begin
null;
end;
---
package P1 is
type Ptr1_Type is private;
Null_Ptr1 : constant Ptr1_Type;
private
type Ptr1_Type is access Boolean;
Null_Ptr1 : constant Ptr1_Type := null;
end;
---
with P1;
package P2 is
pragma Elaborate_Body;
type Ptr2 is private;
Null_Ptr2 : constant Ptr2;
function Is_Null (P : Ptr2) return Boolean is (P = Null_Ptr2);
subtype Not_Null_Ptr2 is Ptr2
with Dynamic_Predicate => not Is_Null (Not_Null_Ptr2);
private
type Ptr2 is new P1.Ptr1_Type;
Null_Ptr2 : constant Ptr2 := Ptr2 (P1.Null_Ptr1);
end;
---
package P2.Child1 is
pragma Elaborate_Body;
end;
---
with P2.Gen1;
package body P2.Child1 is
package Instance is new Gen1 (Boolean);
procedure Foo is
begin
if Is_Null (Null_Ptr2) then
raise Program_Error;
end if;
null;
end;
Thing : Ptr2 := Null_Ptr2;
begin
Foo;
raise Program_Error;
exception
when Program_Error => null;
end;
---
package body P2.Gen1 is
function Bar (P : Ptr2) return Boolean is
begin
return True;
end;
end;
---
generic
type Data_Type is limited private;
package P2.Gen1 is
pragma Elaborate_Body;
end;
---
package body P2 is
function Foo (P : Not_Null_Ptr2) return Ptr2 is
begin
return Null_Ptr2;
end;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-05-26 Ed Schonberg <schonb...@adacore.com>
* sem_ch7.adb (Install_Private_Declarations,
Swap_Private_Dependents): Ensure that both views of the dependent
subtype are immediately visible if we are within their scope. This
may be needed when a procedure body is both the parent of an
instantiated child unit, and is itself used to inline a local
function.
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 223661)
+++ sem_ch7.adb (working copy)
@@ -2221,9 +2221,16 @@
-- swap them out in End_Package_Scope.
Replace_Elmt (Priv_Elmt, Full_View (Priv));
+
+ -- Ensure that both views of the dependent private subtype are
+ -- immediately visible if within some open scope.
+
+ if In_Open_Scopes (Scope (Full_View (Priv))) then
+ Set_Is_Immediately_Visible (Priv);
+ Set_Is_Immediately_Visible (Full_View (Priv));
+ end if;
+
Exchange_Declarations (Priv);
- Set_Is_Immediately_Visible
- (Priv, In_Open_Scopes (Scope (Priv)));
Set_Is_Potentially_Use_Visible
(Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
