aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2017-10-19 23:12:27 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-10-19 23:12:27 +0000
commit7d92172c18f8979710d1baa7cadc43a115dc3a13 (patch)
treed7cf013ae6f4cedde62304bb76490e9c6f9f3b6f
parentfb9dd1c7c32efd0c90c21070ed7dabc9006ef1ef (diff)
downloadgcc-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/ChangeLog5
-rw-r--r--gcc/ada/exp_ch6.adb20
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