@@ -6239,13 +6239,34 @@ package body Freeze is
goto Leave;
- -- Case of no full view present. If entity is derived or subtype,
+ -- Case of no full view present. If entity is subtype or derived,
-- it is safe to freeze, correctness depends on the frozen status
-- of parent. Otherwise it is either premature usage, or a Taft
-- amendment type, so diagnosis is at the point of use and the
-- type might be frozen later.
- elsif E /= Base_Type (E) or else Is_Derived_Type (E) then
+ elsif E /= Base_Type (E) then
+ declare
+ Btyp : constant Entity_Id := Base_Type (E);
+
+ begin
+ -- However, if the base type is itself private and has no
+ -- (underlying) full view either, wait until the full type
+ -- declaration is seen and all the full views are created.
+
+ if Is_Private_Type (Btyp)
+ and then No (Full_View (Btyp))
+ and then No (Underlying_Full_View (Btyp))
+ and then Has_Delayed_Freeze (Btyp)
+ and then No (Freeze_Node (Btyp))
+ then
+ Set_Is_Frozen (E, False);
+ Result := No_List;
+ goto Leave;
+ end if;
+ end;
+
+ elsif Is_Derived_Type (E) then
null;
else
@@ -2733,6 +2733,15 @@ package body Sem_Ch7 is
Propagate_Concurrent_Flags (Priv, Base_Type (Full));
end if;
+ -- As explained in Freeze_Entity, private types are required to point
+ -- to the same freeze node as their corresponding full view, if any.
+ -- But we ought not to overwrite a node already inserted in the tree.
+
+ pragma Assert (Serious_Errors_Detected /= 0
+ or else No (Freeze_Node (Priv))
+ or else No (Parent (Freeze_Node (Priv)))
+ or else Freeze_Node (Priv) = Freeze_Node (Full));
+
Set_Freeze_Node (Priv, Freeze_Node (Full));
-- Propagate Default_Initial_Condition-related attributes from the
new file mode 100644
@@ -0,0 +1,5 @@
+-- { dg-do compile }
+
+package body Generic_Inst2 is
+ procedure Foo (X : not null access T) is null;
+end;
new file mode 100644
@@ -0,0 +1,10 @@
+with Generic_Inst2_C;
+
+package Generic_Inst2 is
+ type T is private;
+ procedure Foo (X : not null access T);
+ package CI is new Generic_Inst2_C (T, Foo => Foo);
+private
+ type S is access Integer;
+ type T is new S;
+end;
new file mode 100644
@@ -0,0 +1,5 @@
+generic
+ type T;
+ with procedure Foo (X : not null access T) is null;
+ with procedure Bar (X : not null access T) is null;
+package Generic_Inst2_C is end;