[Ada] Unnesting: don't use Get_Actual_Subtype for record subtypes

2018-07-17  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not
	active.  Don't use Get_Actual_Subtype for record subtypes.  Ignore
	rewritten identifiers and uplevel references to bounds of types that
	come from the original type reference.

From-SVN: r262787

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c41693033a0b8314b5001dc0008ce16e26874cc0..e7845675d93ebcfbfa7a0c43f539e20e26df54dc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-07-17  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not
+       active.  Don't use Get_Actual_Subtype for record subtypes.  Ignore
+       rewritten identifiers and uplevel references to bounds of types that
+       come from the original type reference.
+
 2018-07-17  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb,

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 9f54eb2bd8d0c647915218675b16dabfd5b559f9..f1c371a765c43969d6e2771ce188e2ff2f5fc005 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -721,6 +721,10 @@ package body Exp_Unst is
                    Bod           => Bod,
                    Lev           => L,
                    Reachable     => In_Synchronized_Unit (E),
+
+                   --  Subprograms declared in tasks and protected types are
+                   --  reachable and cannot be eliminated.
+
                    Uplevel_Ref   => L,
                    Declares_AREC => False,
                    Uents         => No_Elist,
@@ -1932,7 +1936,7 @@ package body Exp_Unst is
                                  --  If we have a loop parameter, we have
                                  --  to insert before the first statement
                                  --  of the loop. Ins points to the
-                                 --  N_Loop_Parametrer_Specification.
+                                 --  N_Loop_Parameter_Specification.
 
                                  if Ekind (Ent) = E_Loop_Parameter then
                                     Ins :=
@@ -1980,9 +1984,18 @@ package body Exp_Unst is
          begin
             --  Ignore type references, these are implicit references that do
             --  not need rewriting (e.g. the appearence in a conversion).
-            --  Also ignore if no reference was specified.
-
-            if Is_Type (UPJ.Ent) or else No (UPJ.Ref) then
+            --  Also ignore if no reference was specified or if the rewriting
+            --  has already been done (this can happen if the N_Identifier
+            --  occurs more than one time in the tree).
+           --  Also ignore uplevel references to bounds of types that come
+           --  from the original type reference.
+
+            if Is_Type (UPJ.Ent)
+              or else No (UPJ.Ref)
+              or else not Is_Entity_Name (UPJ.Ref)
+              or else not Present (Entity (UPJ.Ref))
+              or else Is_Type (Entity (UPJ.Ref))
+            then
                goto Continue;
             end if;
 
@@ -2005,7 +2018,7 @@ package body Exp_Unst is
                Typ : constant Entity_Id := Etype (UPJ.Ent);
                --  The type of the referenced entity
 
-               Atyp : constant Entity_Id := Get_Actual_Subtype (UPJ.Ref);
+               Atyp : Entity_Id;
                --  The actual subtype of the reference
 
                RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller);
@@ -2025,6 +2038,12 @@ package body Exp_Unst is
                SI   : SI_Type;
 
             begin
+               Atyp := Etype (UPJ.Ref);
+
+               if Ekind (Atyp) /= E_Record_Subtype then
+                  Atyp := Get_Actual_Subtype (UPJ.Ref);
+               end if;
+
                --  Ignore if no ARECnF entity for enclosing subprogram which
                --  probably happens as a result of not properly treating
                --  instance bodies. To be examined ???
@@ -2344,7 +2363,7 @@ package body Exp_Unst is
    --  Start of processing for Unnest_Subprograms
 
    begin
-      if not Opt.Unnest_Subprogram_Mode then
+      if not Opt.Unnest_Subprogram_Mode or not Opt.Expander_Active then
          return;
       end if;