Commit 97c0b990 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Unnesting: improve handling of private and incomplete types

2019-07-01  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node, Check_Static_Type): Improve the
	handling of private and incomplete types whose full view is an
	access type, to detect additional uplevel references in dynamic
	bounds. This is relevant to N_Free_Statement among others that
	manipulate types whose full viww may be an access type.

From-SVN: r272870
parent 76fd9416
2019-07-01 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Visit_Node, Check_Static_Type): Improve the
handling of private and incomplete types whose full view is an
access type, to detect additional uplevel references in dynamic
bounds. This is relevant to N_Free_Statement among others that
manipulate types whose full viww may be an access type.
2019-07-01 Pat Rogers <rogers@adacore.com> 2019-07-01 Pat Rogers <rogers@adacore.com>
* doc/gnat_rm/representation_clauses_and_pragmas.rst: Correct * doc/gnat_rm/representation_clauses_and_pragmas.rst: Correct
......
...@@ -463,7 +463,10 @@ package body Exp_Unst is ...@@ -463,7 +463,10 @@ package body Exp_Unst is
Callee : Entity_Id; Callee : Entity_Id;
procedure Check_Static_Type procedure Check_Static_Type
(T : Entity_Id; N : Node_Id; DT : in out Boolean); (T : Entity_Id;
N : Node_Id;
DT : in out Boolean;
Check_Designated : Boolean := False);
-- Given a type T, checks if it is a static type defined as a type -- Given a type T, checks if it is a static type defined as a type
-- with no dynamic bounds in sight. If so, the only action is to -- with no dynamic bounds in sight. If so, the only action is to
-- set Is_Static_Type True for T. If T is not a static type, then -- set Is_Static_Type True for T. If T is not a static type, then
...@@ -473,6 +476,9 @@ package body Exp_Unst is ...@@ -473,6 +476,9 @@ package body Exp_Unst is
-- node that will need to be replaced. If not specified, it means -- node that will need to be replaced. If not specified, it means
-- we can't do a replacement because the bound is implicit. -- we can't do a replacement because the bound is implicit.
-- If Check_Designated is True and T or its full view is an access
-- type, check whether the designated type has dynamic bounds.
procedure Note_Uplevel_Ref procedure Note_Uplevel_Ref
(E : Entity_Id; (E : Entity_Id;
N : Node_Id; N : Node_Id;
...@@ -491,7 +497,10 @@ package body Exp_Unst is ...@@ -491,7 +497,10 @@ package body Exp_Unst is
----------------------- -----------------------
procedure Check_Static_Type procedure Check_Static_Type
(T : Entity_Id; N : Node_Id; DT : in out Boolean) (T : Entity_Id;
N : Node_Id;
DT : in out Boolean;
Check_Designated : Boolean := False)
is is
procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id); procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
-- N is the bound of a dynamic type. This procedure notes that -- N is the bound of a dynamic type. This procedure notes that
...@@ -601,7 +610,7 @@ package body Exp_Unst is ...@@ -601,7 +610,7 @@ package body Exp_Unst is
begin begin
-- If already marked static, immediate return -- If already marked static, immediate return
if Is_Static_Type (T) then if Is_Static_Type (T) and then not Check_Designated then
return; return;
end if; end if;
...@@ -684,13 +693,20 @@ package body Exp_Unst is ...@@ -684,13 +693,20 @@ package body Exp_Unst is
-- For private type, examine whether full view is static -- For private type, examine whether full view is static
elsif Is_Private_Type (T) and then Present (Full_View (T)) then elsif Is_Incomplete_Or_Private_Type (T)
Check_Static_Type (Full_View (T), N, DT); and then Present (Full_View (T))
then
Check_Static_Type (Full_View (T), N, DT, Check_Designated);
if Is_Static_Type (Full_View (T)) then if Is_Static_Type (Full_View (T)) then
Set_Is_Static_Type (T); Set_Is_Static_Type (T);
end if; end if;
-- For access types, check designated type when required.
elsif Is_Access_Type (T) and then Check_Designated then
Check_Static_Type (Directly_Designated_Type (T), N, DT);
-- For now, ignore other types -- For now, ignore other types
else else
...@@ -935,7 +951,11 @@ package body Exp_Unst is ...@@ -935,7 +951,11 @@ package body Exp_Unst is
declare declare
DT : Boolean := False; DT : Boolean := False;
begin begin
Check_Static_Type (Etype (Expression (N)), Empty, DT); Check_Static_Type
(Etype (Expression (N)),
Empty,
DT,
Check_Designated => Nkind (N) = N_Free_Statement);
end; end;
end if; end if;
......
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