Re: [Patch, Fortran] PR57530 - fix rejects valid with gfc_type_compatible

[Tobias Burnus]

Now with attached patch.

Tobias Burnus wrote:

I accidentally attached a slightly out-dated patch. The old patch permitted CLASS<->TYPE differences in cases where the characteristic had to match (e.g. dummy arguments in a proc-pointer assignment). - Sorry for the confusion.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

Tobias Burnus wrote:

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?

2013-06-05  Tobias Burnus  <bur...@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.
	* interface.c (compare_type): Reject CLASS/TYPE even if they
	are type compatible.

2013-06-05  Tobias Burnus  <bur...@net-b.de>

	PR fortran/57530
	* gfortran.dg/pointer_assign_8.f90: New.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f06ecfe..17a47a2 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -514,6 +514,12 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2)
   if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
     return 1;
 
+  /* TYPE and CLASS of the same declared type are type compatible,
+     but have different characteristics.  */
+  if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED)
+      || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS))
+    return 0;
+
   return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED;
 }
 
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