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 21337393b72b27dff4de1a9e0f6d349f9db1790d..f3d7209ff5b8ea374297515785004d09fbae4310 100644 (file)
--- 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 c5cea3e6aafbd59e8040919c555bc8bb1b83ecac..ecef075a85ea4dd029acf21f419cc25fd00a81d5 100644 (file)
--- 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