Commit d37209bf by Gary Dismukes Committed by Arnaud Charlet

layout.adb (Discrimify): Remove resetting of Vtype to the underlying type which…

layout.adb (Discrimify): Remove resetting of Vtype to the underlying type which turns out to be an...

2005-06-14  Gary Dismukes  <dismukes@adacore.com>

	* layout.adb (Discrimify): Remove resetting of Vtype to the underlying
	type which turns out to be an incomplete and incorrect fix.
	(Layout_Array_Type): Use Underlying_Type when checking whether the scope
	of the type is declared in a record (for determination of insertion
	type).
	(SO_Ref_From_Expr): Test whether Vtype denotes a partial or full view of
	a private type and ensure that the primary entity is used for the type
	of the newly created function's V formal by taking the Etype of the
	view.

From-SVN: r101044
parent 564383da
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -993,12 +993,6 @@ package body Layout is ...@@ -993,12 +993,6 @@ package body Layout is
Decl := Parent (Parent (Entity (N))); Decl := Parent (Parent (Entity (N)));
Size := (Discrim, Size.Nod); Size := (Discrim, Size.Nod);
Vtyp := Defining_Identifier (Decl); Vtyp := Defining_Identifier (Decl);
-- Ensure that we get a private type's full type
if Present (Underlying_Type (Vtyp)) then
Vtyp := Underlying_Type (Vtyp);
end if;
end if; end if;
Typ := Etype (N); Typ := Etype (N);
...@@ -1029,8 +1023,8 @@ package body Layout is ...@@ -1029,8 +1023,8 @@ package body Layout is
-- Calculate proper type for insertions -- Calculate proper type for insertions
if Is_Record_Type (Scope (E)) then if Is_Record_Type (Underlying_Type (Scope (E))) then
Insert_Typ := Scope (E); Insert_Typ := Underlying_Type (Scope (E));
else else
Insert_Typ := E; Insert_Typ := E;
end if; end if;
...@@ -2951,6 +2945,8 @@ package body Layout is ...@@ -2951,6 +2945,8 @@ package body Layout is
Decl : Node_Id; Decl : Node_Id;
Vtype_Primary_View : Entity_Id;
function Check_Node_V_Ref (N : Node_Id) return Traverse_Result; function Check_Node_V_Ref (N : Node_Id) return Traverse_Result;
-- Function used to check one node for reference to V -- Function used to check one node for reference to V
...@@ -2992,6 +2988,21 @@ package body Layout is ...@@ -2992,6 +2988,21 @@ package body Layout is
if Has_V_Ref (Expr) = Abandon then if Has_V_Ref (Expr) = Abandon then
pragma Assert (Present (Vtype)); pragma Assert (Present (Vtype));
-- Check whether Vtype is a view of a private type and ensure that
-- we use the primary view of the type (which is denoted by its
-- Etype, whether it's the type's partial or full view entity).
-- This is needed to make sure that we use the same (primary) view
-- of the type for all V formals, whether the current view of the
-- type is the partial or full view, so that types will always
-- match on calls from one size function to another.
if Has_Private_Declaration (Vtype) then
Vtype_Primary_View := Etype (Vtype);
else
Vtype_Primary_View := Vtype;
end if;
Set_Is_Discrim_SO_Function (K); Set_Is_Discrim_SO_Function (K);
Decl := Decl :=
...@@ -3005,7 +3016,7 @@ package body Layout is ...@@ -3005,7 +3016,7 @@ package body Layout is
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Chars => Vname), Make_Defining_Identifier (Loc, Chars => Vname),
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (Vtype, Loc))), New_Occurrence_Of (Vtype_Primary_View, Loc))),
Subtype_Mark => Subtype_Mark =>
New_Occurrence_Of (Standard_Unsigned, Loc)), New_Occurrence_Of (Standard_Unsigned, Loc)),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment