From 7d92172c18f8979710d1baa7cadc43a115dc3a13 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 19 Oct 2017 23:12:27 +0000 Subject: [PATCH] exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ" should be "T". 2017-10-19 Bob Duff * 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch6.adb | 20 +++++++++++--------- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2133739..f3d7209 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2017-10-19 Bob Duff + * 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 + * exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify which node kinds can legitimately be ignored, and raise Program_Error for others. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c5cea3e..ecef075 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 -- 2.7.4