This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran] PR57530 - fix rejects valid with gfc_type_compatible
- From: Tobias Burnus <burnus at net-b dot de>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 05 Jun 2013 14:01:26 +0200
- Subject: [Patch, Fortran] PR57530 - fix rejects valid with gfc_type_compatible
A TYPE is type compatible with a CLASS if both have the same declared type.
Or in words of the standard (cf. PR):
"A nonpolymorphic entity is type compatible only with entities of the
same declared type. A polymorphic entity that is not an unlimited
polymorphic entity is type compatible with entities of the same declared
type or any of its extensions." (F2008, 4.3.1.3).
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-06-05 Tobias Burnus <burnus@net-b.de>
PR fortran/57530
* symbol.c (gfc_type_compatible): A type is type compatible with
a class if both have the same declared type.
2013-06-05 Tobias Burnus <burnus@net-b.de>
PR fortran/57530
* gfortran.dg/pointer_assign_8.f90: New.
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c72974d..9d23e8b 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4489,6 +4489,9 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2)
if (is_derived1 && is_derived2)
return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived);
+ if (is_derived1 && is_class2)
+ return gfc_compare_derived_types (ts1->u.derived,
+ ts2->u.derived->components->ts.u.derived);
if (is_class1 && is_derived2)
return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
ts2->u.derived);
--- /dev/null 2013-06-05 09:13:09.179105369 +0200
+++ gcc/gcc/testsuite/gfortran.dg/pointer_assign_8.f90 2013-06-05 13:55:12.580621132 +0200
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/57530
+!
+module m
+ type t
+ end type t
+contains
+ subroutine sub (tgt)
+ class(t), target :: tgt
+ type(t), pointer :: ptr
+ ptr => tgt ! TYPE => CLASS of same declared type
+ end subroutine sub
+end module m