Patchwork [Fortran] PR57530 - fix rejects valid with gfc_type_compatible

login
register
mail settings
Submitter Tobias Burnus
Date June 5, 2013, 12:49 p.m.
Message ID <51AF33C6.3080209@net-b.de>
Download mbox | patch
Permalink /patch/249025/
State New
Headers show

Comments

Tobias Burnus - June 5, 2013, 12:49 p.m.
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?
>
>
Mikael Morin - June 6, 2013, 9:30 a.m.
Le 05/06/2013 14:49, Tobias Burnus a écrit :
> 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?
>>
OK

Patch

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.
	* interface.c (compare_type): Reject CLASS/TYPE even if they
	are type compatible.

2013-06-05  Tobias Burnus  <burnus@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