diff options
author | Bob Duff <duff@adacore.com> | 2017-10-19 23:12:27 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2017-10-19 23:12:27 +0000 |
commit | 7d92172c18f8979710d1baa7cadc43a115dc3a13 (patch) | |
tree | d7cf013ae6f4cedde62304bb76490e9c6f9f3b6f | |
parent | fb9dd1c7c32efd0c90c21070ed7dabc9006ef1ef (diff) | |
download | gcc-7d92172c18f8979710d1baa7cadc43a115dc3a13.zip gcc-7d92172c18f8979710d1baa7cadc43a115dc3a13.tar.gz gcc-7d92172c18f8979710d1baa7cadc43a115dc3a13.tar.bz2 |
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
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | 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 <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 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 |