From: Bob Duff <duff@adacore.com>
Date: Thu, 19 Oct 2017 23:12:27 +0000 (+0000)
Subject: exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ" should be "T".
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7d92172c18f8979710d1baa7cadc43a115dc3a13;p=gcc.git

exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ" should be "T".

2017-10-19  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ"
	should be "T".  Handle case of a subtype of a class-wide type.

From-SVN: r253916
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 21337393b72..f3d7209ff5b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2017-10-19  Bob Duff  <duff@adacore.com>
+
+	* exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ"
+	should be "T".  Handle case of a subtype of a class-wide type.
+
 2017-10-19  Bob Duff  <duff@adacore.com>
 
 	* exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index c5cea3e6aaf..ecef075a85e 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7249,26 +7249,28 @@ package body Exp_Ch6 is
          begin
             --  For T'Class, return True if it's True for T. This is necessary
             --  because a class-wide function might say "return F (...)", where
-            --  F returns the corresponding specific type.
+            --  F returns the corresponding specific type. We need a loop in
+            --  case T is a subtype of a class-wide type.
 
-            if Is_Class_Wide_Type (Typ) then
-               T := Etype (Typ);
-            end if;
+            while Is_Class_Wide_Type (T) loop
+               T := Etype (T);
+            end loop;
 
             --  If this is a generic formal type in an instance, return True if
             --  it's True for the generic actual type.
 
-            if Nkind (Parent (Typ)) = N_Subtype_Declaration
-              and then Present (Generic_Parent_Type (Parent (Typ)))
+            if Nkind (Parent (T)) = N_Subtype_Declaration
+              and then Present (Generic_Parent_Type (Parent (T)))
             then
-               T := Entity (Subtype_Indication (Parent (Typ)));
+               T := Entity (Subtype_Indication (Parent (T)));
 
                if Present (Full_View (T)) then
                   T := Full_View (T);
                end if;
+            end if;
 
-            elsif Present (Underlying_Type (Typ)) then
-               T := Underlying_Type (Typ);
+            if Present (Underlying_Type (T)) then
+               T := Underlying_Type (T);
             end if;
 
             declare