[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e624e6b..25a9ef9 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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>
 
        * doc/gnat_rm/representation_clauses_and_pragmas.rst: Correct

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 5aa1fa6..f7f488a 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -463,7 +463,10 @@ package body Exp_Unst is
             Callee : Entity_Id;
 
             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
             --  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
@@ -473,6 +476,9 @@ package body Exp_Unst is
             --  node that will need to be replaced. If not specified, it means
             --  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
               (E      : Entity_Id;
                N      : Node_Id;
@@ -491,7 +497,10 @@ package body Exp_Unst is
             -----------------------
 
             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
                procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
                --  N is the bound of a dynamic type. This procedure notes that
@@ -601,7 +610,7 @@ package body Exp_Unst is
             begin
                --  If already marked static, immediate return
 
-               if Is_Static_Type (T) then
+               if Is_Static_Type (T) and then not Check_Designated then
                   return;
                end if;
 
@@ -684,13 +693,20 @@ package body Exp_Unst is
 
                --  For private type, examine whether full view is static
 
-               elsif Is_Private_Type (T) and then Present (Full_View (T)) then
-                  Check_Static_Type (Full_View (T), N, DT);
+               elsif Is_Incomplete_Or_Private_Type (T)
+                 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
                      Set_Is_Static_Type (T);
                   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
 
                else
@@ -935,7 +951,11 @@ package body Exp_Unst is
                      declare
                         DT : Boolean := False;
                      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 if;