===================================================================
@@ -3764,7 +3764,10 @@
DT_Aggr : constant Elist_Id := New_Elmt_List;
-- Entities marked with attribute Is_Dispatch_Table_Entity
- procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id);
+ procedure Check_Premature_Freezing
+ (Subp : Entity_Id;
+ Tagged_Type : Entity_Id;
+ Typ : Entity_Id);
-- Verify that all non-tagged types in the profile of a subprogram
-- are frozen at the point the subprogram is frozen. This enforces
-- the rule on RM 13.14 (14) as modified by AI05-019. At the point a
@@ -3775,6 +3778,8 @@
-- Typical violation of the rule involves an object declaration that
-- freezes a tagged type, when one of its primitive operations has a
-- type in its profile whose full view has not been analyzed yet.
+ -- More complex cases involve composite types that have one private
+ -- unfrozen subcomponent.
procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0);
-- Export the dispatch table DT of tagged type Typ. Required to generate
@@ -3814,10 +3819,15 @@
-- Check_Premature_Freezing --
------------------------------
- procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id) is
+ procedure Check_Premature_Freezing
+ (Subp : Entity_Id;
+ Tagged_Type : Entity_Id;
+ Typ : Entity_Id)
+ is
+ Comp : Entity_Id;
begin
if Present (N)
- and then Is_Private_Type (Typ)
+ and then Is_Private_Type (Typ)
and then No (Full_View (Typ))
and then not Is_Generic_Type (Typ)
and then not Is_Tagged_Type (Typ)
@@ -3828,8 +3838,26 @@
("declaration must appear after completion of type &", N, Typ);
Error_Msg_NE
("\which is an untagged type in the profile of"
- & " primitive operation & declared#",
- N, Subp);
+ & " primitive operation & declared#", N, Subp);
+
+ else
+ Comp := Private_Component (Typ);
+
+ if not Is_Tagged_Type (Typ)
+ and then Present (Comp)
+ and then not Is_Frozen (Comp)
+ then
+ Error_Msg_Sloc := Sloc (Subp);
+ Error_Msg_Node_2 := Subp;
+ Error_Msg_Name_1 := Chars (Tagged_Type);
+ Error_Msg_NE
+ ("declaration must appear after completion of type &",
+ N, Comp);
+ Error_Msg_NE
+ ("\which is a component of untagged type& in the profile of"
+ & " primitive & of type % that is frozen by the declaration ",
+ N, Typ);
+ end if;
end if;
end Check_Premature_Freezing;
@@ -4587,11 +4615,11 @@
begin
F := First_Formal (Prim);
while Present (F) loop
- Check_Premature_Freezing (Prim, Etype (F));
+ Check_Premature_Freezing (Prim, Typ, Etype (F));
Next_Formal (F);
end loop;
- Check_Premature_Freezing (Prim, Etype (Prim));
+ Check_Premature_Freezing (Prim, Typ, Etype (Prim));
end;
if Present (Frnodes) then
When a tagged type is frozen, its primitive operations are frozen, and the profiles of these operations are frozen as well. This patch checks that these profiles do not include a non-private type with a private unfrozen subcomponent, and report an error otherwise. Previously the compiler only flagged unfrozen private types appearing directly in a profile. Compiling p.adb must yield: p.ads:13:04: declaration must appear after completion of type "Int" p.ads:13:04: which is a component of untagged type "Arr" in the profile of primitive operation "Proc" declared at line 11 package P is type Int is private; type Arr is array (Positive range <>) of Int; type Rec is tagged record Res : Integer; end record; procedure Proc (Result : Rec; Params : Arr); N : constant Rec := (Res => 0); private type Int is new Integer; end P; --- package body P is procedure Proc (Result : Rec; Params : Arr) is begin null; end; end P; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-03 Ed Schonberg <schonberg@adacore.com> * exp_disp.adb (Check_Premature_Freezing): diagnose the presence of a composite type with an unfrozen subcomponent, in the profile of a primitive operation.