[multiple changes]
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Create_Finalizer): Remove local variables Spec_Nod and Vis_Decls. When creating a library-level finalizer for a package spec, both the declaration and body of the finalizer are inserted either in the visible or private declarations of the package spec. 2011-08-04 Javier Miranda <miranda@adacore.com> * sem_ch3.adb (Derive_Subprograms): Complete assertion to request the use of the full-view of a type when invoking Is_Ancestor. * sem_type.adb (Is_Ancestor): For consistency, when the traversal of the full-view of private parents is requested, then use also the full-view of the parent of the first derivation. From-SVN: r177338
This commit is contained in:
parent
7ab4d95af7
commit
b37d5bc62b
|
@ -1,3 +1,18 @@
|
|||
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch7.adb (Create_Finalizer): Remove local variables Spec_Nod and
|
||||
Vis_Decls. When creating a library-level finalizer for a package spec,
|
||||
both the declaration and body of the finalizer are inserted either in
|
||||
the visible or private declarations of the package spec.
|
||||
|
||||
2011-08-04 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Derive_Subprograms): Complete assertion to request the
|
||||
use of the full-view of a type when invoking Is_Ancestor.
|
||||
* sem_type.adb (Is_Ancestor): For consistency, when the traversal of
|
||||
the full-view of private parents is requested, then use also the
|
||||
full-view of the parent of the first derivation.
|
||||
|
||||
2011-08-04 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* s-taprop-vxworks.adb (Enter_Task): Use System.Float_Control.Reset
|
||||
|
|
|
@ -1562,38 +1562,23 @@ package body Exp_Ch7 is
|
|||
|
||||
-- If the package spec has private declarations, the finalizer
|
||||
-- body must be added to the end of the list in order to have
|
||||
-- visibility of all private controlled objects. The spec is
|
||||
-- inserted at the top of the visible declarations.
|
||||
-- visibility of all private controlled objects.
|
||||
|
||||
if For_Package_Spec then
|
||||
Prepend_To (Decls, Fin_Spec);
|
||||
|
||||
if Present (Priv_Decls) then
|
||||
Append_To (Priv_Decls, Fin_Spec);
|
||||
Append_To (Priv_Decls, Fin_Body);
|
||||
else
|
||||
Append_To (Decls, Fin_Spec);
|
||||
Append_To (Decls, Fin_Body);
|
||||
end if;
|
||||
|
||||
-- For package bodies, the finalizer body is added to the
|
||||
-- declarative region of the body and finalizer spec goes
|
||||
-- on the visible declarations of the package spec.
|
||||
-- For package bodies, both the finalizer spec and body are
|
||||
-- inserted at the end of the package declarations.
|
||||
|
||||
else
|
||||
declare
|
||||
Spec_Nod : Node_Id;
|
||||
Vis_Decls : List_Id;
|
||||
|
||||
begin
|
||||
Spec_Nod := Spec_Id;
|
||||
while Nkind (Spec_Nod) /= N_Package_Specification loop
|
||||
Spec_Nod := Parent (Spec_Nod);
|
||||
end loop;
|
||||
|
||||
Vis_Decls := Visible_Declarations (Spec_Nod);
|
||||
|
||||
Prepend_To (Vis_Decls, Fin_Spec);
|
||||
Append_To (Decls, Fin_Body);
|
||||
end;
|
||||
Append_To (Decls, Fin_Spec);
|
||||
Append_To (Decls, Fin_Body);
|
||||
end if;
|
||||
|
||||
-- Push the name of the package
|
||||
|
|
|
@ -13647,7 +13647,8 @@ package body Sem_Ch3 is
|
|||
Type_Conformant (Subp, Act_Subp,
|
||||
Skip_Controlling_Formals => True)))
|
||||
then
|
||||
pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual));
|
||||
pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual,
|
||||
Use_Full_View => True));
|
||||
|
||||
-- Remember that we need searching for all pending primitives
|
||||
|
||||
|
|
|
@ -2656,7 +2656,23 @@ package body Sem_Type is
|
|||
return True;
|
||||
|
||||
else
|
||||
Par := Etype (BT2);
|
||||
-- Obtain the parent of the base type of T2 (use the full view if
|
||||
-- allowed).
|
||||
|
||||
if Use_Full_View
|
||||
and then Is_Private_Type (BT2)
|
||||
and then Present (Full_View (BT2))
|
||||
then
|
||||
-- No climbing needed if its full view is the root type
|
||||
|
||||
if Full_View (BT2) = Root_Type (Full_View (BT2)) then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
Par := Etype (Full_View (BT2));
|
||||
else
|
||||
Par := Etype (BT2);
|
||||
end if;
|
||||
|
||||
loop
|
||||
-- If there was a error on the type declaration, do not recurse
|
||||
|
@ -2677,10 +2693,14 @@ package body Sem_Type is
|
|||
then
|
||||
return True;
|
||||
|
||||
-- Climb to the ancestor type
|
||||
-- Root type found
|
||||
|
||||
elsif Etype (Par) /= Par then
|
||||
elsif Par = Root_Type (Par) then
|
||||
return False;
|
||||
|
||||
-- Continue climbing
|
||||
|
||||
else
|
||||
-- Use the full-view of private types (if allowed)
|
||||
|
||||
if Use_Full_View
|
||||
|
@ -2691,11 +2711,6 @@ package body Sem_Type is
|
|||
else
|
||||
Par := Etype (Par);
|
||||
end if;
|
||||
|
||||
-- For all other cases return False, not an Ancestor
|
||||
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end loop;
|
||||
end if;
|
||||
|
|
Loading…
Reference in New Issue