[Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 608 bytes --]

The attached patch is explained by the ChangeLog and the comments.

Boostrapped and regtested on RHEL5.4/i686 - OK for trunk and 4.5?

Paul

2010-05-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43945
	* resolve.c (get_declared_from_expr): Move to before
	resolve_typebound_generic_call.  Make new_ref and class_ref
	ignorable if set to NULL.
	(resolve_typebound_generic_call): Once we have resolved the
	generic call, check that the specific instance is that which
	is bound to the declared type.

2010-05-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43945
	* gfortran.dg/generic_23.f03: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 4773 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 158958)
+++ gcc/fortran/resolve.c	(working copy)
@@ -5123,6 +5123,43 @@
 }
 
 
+/* Get the ultimate declared type from an expression.  In addition,
+   return the last class/derived type reference and the copy of the
+   reference list.  */
+static gfc_symbol*
+get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
+			gfc_expr *e)
+{
+  gfc_symbol *declared;
+  gfc_ref *ref;
+
+  declared = NULL;
+  if (class_ref)
+    *class_ref = NULL;
+  if (new_ref)
+    *new_ref = gfc_copy_ref (e->ref);
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type != REF_COMPONENT)
+	continue;
+
+      if (ref->u.c.component->ts.type == BT_CLASS
+	    || ref->u.c.component->ts.type == BT_DERIVED)
+	{
+	  declared = ref->u.c.component->ts.u.derived;
+	  if (class_ref)
+	    *class_ref = ref;
+	}
+    }
+
+  if (declared == NULL)
+    declared = e->symtree->n.sym->ts.u.derived;
+
+  return declared;
+}
+
+
 /* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out
    which of the specific bindings (if any) matches the arglist and transform
    the expression into a call of that binding.  */
@@ -5132,6 +5169,8 @@
 {
   gfc_typebound_proc* genproc;
   const char* genname;
+  gfc_symtree *st;
+  gfc_symbol *derived;
 
   gcc_assert (e->expr_type == EXPR_COMPCALL);
   genname = e->value.compcall.name;
@@ -5199,6 +5238,19 @@
   return FAILURE;
 
 success:
+  /* Make sure that we have the right specific instance for the name.  */
+  genname = e->value.compcall.tbp->u.specific->name;
+
+  /* Is the symtree name a "unique name".  */
+  if (*genname == '@')
+    genname = e->value.compcall.tbp->u.specific->n.sym->name;
+
+  derived = get_declared_from_expr (NULL, NULL, e);
+
+  st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where);
+  if (st)
+    e->value.compcall.tbp = st->n.tb;
+
   return SUCCESS;
 }
 
@@ -5306,39 +5358,7 @@
 }
 
 
-/* Get the ultimate declared type from an expression.  In addition,
-   return the last class/derived type reference and the copy of the
-   reference list.  */
-static gfc_symbol*
-get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
-			gfc_expr *e)
-{
-  gfc_symbol *declared;
-  gfc_ref *ref;
 
-  declared = NULL;
-  *class_ref = NULL;
-  *new_ref = gfc_copy_ref (e->ref);
-  for (ref = *new_ref; ref; ref = ref->next)
-    {
-      if (ref->type != REF_COMPONENT)
-	continue;
-
-      if (ref->u.c.component->ts.type == BT_CLASS
-	    || ref->u.c.component->ts.type == BT_DERIVED)
-	{
-	  declared = ref->u.c.component->ts.u.derived;
-	  *class_ref = ref;
-	}
-    }
-
-  if (declared == NULL)
-    declared = e->symtree->n.sym->ts.u.derived;
-
-  return declared;
-}
-
-
 /* Resolve a typebound function, or 'method'. First separate all
    the non-CLASS references by calling resolve_compcall directly.  */
 
Index: gcc/testsuite/gfortran.dg/generic_23.f03
===================================================================
--- gcc/testsuite/gfortran.dg/generic_23.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/generic_23.f03	(revision 0)
@@ -0,0 +1,67 @@
+! { dg-do run }
+! Test the fix for PR43945 in which the over-ridding of 'doit' and
+! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! and reported to clf by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit,getit
+contains
+  subroutine  doit(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+!!$    generic, public :: do  => doit
+!!$    generic, public :: get => getit
+  end type foo2
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Tobias Burnus]

Paul Richard Thomas wrote:
> The attached patch is explained by the ChangeLog and the comments.
> Boostrapped and regtested on RHEL5.4/i686 - OK for trunk and 4.5?
>   
OK. Thanks for the patch!

Tobias
> 2010-05-06  Paul Thomas  <pault@gcc.gnu.org>
>
> 	PR fortran/43945
> 	* resolve.c (get_declared_from_expr): Move to before
> 	resolve_typebound_generic_call.  Make new_ref and class_ref
> 	ignorable if set to NULL.
> 	(resolve_typebound_generic_call): Once we have resolved the
> 	generic call, check that the specific instance is that which
> 	is bound to the declared type.
>
> 2010-05-06  Paul Thomas  <pault@gcc.gnu.org>
>
> 	PR fortran/43945
> 	* gfortran.dg/generic_23.f03: New test.
>   

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

Tobias,

I am finally in a position to commit this one but, on a different
system, it has started segfaulting on my old friend
dynamic_dispatch_5.f03 (and on coarray_8.f90).  At the moment, I do
not see why.

Program received signal SIGSEGV, Segmentation fault.
gfc_free_ref_list (p=0x180) at ../../trunk/gcc/fortran/expr.c:561
561	      switch (p->type)

Anyway,  I'll report back when I have a solution.

Cheers

Paul

On Sat, May 8, 2010 at 12:00 AM, Tobias Burnus <burnus@net-b.de> wrote:
> Paul Richard Thomas wrote:
>> The attached patch is explained by the ChangeLog and the comments.
>> Boostrapped and regtested on RHEL5.4/i686 - OK for trunk and 4.5?
>>
> OK. Thanks for the patch!
>
> Tobias
>> 2010-05-06  Paul Thomas  <pault@gcc.gnu.org>
>>
>>       PR fortran/43945
>>       * resolve.c (get_declared_from_expr): Move to before
>>       resolve_typebound_generic_call.  Make new_ref and class_ref
>>       ignorable if set to NULL.
>>       (resolve_typebound_generic_call): Once we have resolved the
>>       generic call, check that the specific instance is that which
>>       is bound to the declared type.
>>
>> 2010-05-06  Paul Thomas  <pault@gcc.gnu.org>
>>
>>       PR fortran/43945
>>       * gfortran.dg/generic_23.f03: New test.
>>
>
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Janus Weil]

> I am finally in a position to commit this one but, on a different
> system, it has started segfaulting on my old friend
> dynamic_dispatch_5.f03 (and on coarray_8.f90).  At the moment, I do
> not see why.

I currently see this failing not only on dynamic_dispatch_5, but also
on ..._7 and ..._8:

FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O1  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O1  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O2  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O2  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
(internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
(test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
-funroll-loops  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
-funroll-loops  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -g  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -O3 -g  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -Os  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_5.f03  -Os  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O1  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O1  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O2  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O2  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
(internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
(test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
-funroll-loops  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
-funroll-loops  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -g  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -O3 -g  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -Os  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_7.f03  -Os  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O1  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O1  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O2  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O2  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
(internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
(test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
-funroll-loops  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
-funroll-loops  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -fomit-frame-pointer
-funroll-all-loops -finline-functions  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -g  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -O3 -g  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -Os  (internal compiler error)
FAIL: gfortran.dg/dynamic_dispatch_8.f03  -Os  (test for excess errors)


Cheers,
Janus

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Janus Weil]

> That looks OK to me - thanks.


Committed as r160335.

Cheers,
Janus

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

Dominique,

On Sat, Jun 5, 2010 at 6:33 PM, Dominique Dhumieres <dominiq@lps.ens.fr> wrote:
>> I was beginning to wonder if today's sunshine was too much for you :-)
>
> Only disturbed by the incredible arrogance of the FSF and SC.
> Pondering between LOL or "le ridicule ne tue pas!".

Il faut mieux le dernier...

Paul

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Dominique Dhumieres]

> I was beginning to wonder if today's sunshine was too much for you :-)

Only disturbed by the incredible arrogance of the FSF and SC.
Pondering between LOL or "le ridicule ne tue pas!".

Dominique

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

Dominique,

On Sat, Jun 5, 2010 at 5:59 PM, Dominique Dhumieres <dominiq@lps.ens.fr> wrote:
> Oops! wrong copy and past!-(I mean
>
> http://gcc.gnu.org/bugzilla/attachment.cgi?id=20522&action=view
>

I was beginning to wonder if today's sunshine was too much for you :-)

Cheers

Paul

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Dominique Dhumieres]

Oops! wrong copy and past!-(I mean

http://gcc.gnu.org/bugzilla/attachment.cgi?id=20522&action=view

Dominique

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Dominique Dhumieres]

The latest patch tested fine without regression.
However it does not fix the ICE for the test in

http://myweb.lmu.edu/dmsmith/fmlib.html

probably another bug.

Thanks for the patch.

Dominique

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

Janus,

That looks OK to me - thanks.

Cheers

Paul

On Sat, Jun 5, 2010 at 1:48 AM, Janus Weil <janus@gcc.gnu.org> wrote:
>> The full patch can be found in the attachment.
>
> ... which is missing of course. Here it goes.
>
> Janus
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 103 bytes --]

> The full patch can be found in the attachment.

... which is missing of course. Here it goes.

Janus

[-- Attachment #2: pr43945_2.diff --]
[-- Type: application/octet-stream, Size: 5793 bytes --]

Index: gcc/testsuite/gfortran.dg/generic_23.f03
===================================================================
--- gcc/testsuite/gfortran.dg/generic_23.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/generic_23.f03	(revision 0)
@@ -0,0 +1,67 @@
+! { dg-do run }
+! Test the fix for PR43945 in which the over-ridding of 'doit' and
+! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! and reported to clf by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit,getit
+contains
+  subroutine  doit(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+!!$    generic, public :: do  => doit
+!!$    generic, public :: get => getit
+  end type foo2
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 160300)
+++ gcc/fortran/resolve.c	(working copy)
@@ -5160,6 +5160,43 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree
 }
 
 
+/* Get the ultimate declared type from an expression.  In addition,
+   return the last class/derived type reference and the copy of the
+   reference list.  */
+static gfc_symbol*
+get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
+			gfc_expr *e)
+{
+  gfc_symbol *declared;
+  gfc_ref *ref;
+
+  declared = NULL;
+  if (class_ref)
+    *class_ref = NULL;
+  if (new_ref)
+    *new_ref = gfc_copy_ref (e->ref);
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type != REF_COMPONENT)
+	continue;
+
+      if (ref->u.c.component->ts.type == BT_CLASS
+	    || ref->u.c.component->ts.type == BT_DERIVED)
+	{
+	  declared = ref->u.c.component->ts.u.derived;
+	  if (class_ref)
+	    *class_ref = ref;
+	}
+    }
+
+  if (declared == NULL)
+    declared = e->symtree->n.sym->ts.u.derived;
+
+  return declared;
+}
+
+
 /* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out
    which of the specific bindings (if any) matches the arglist and transform
    the expression into a call of that binding.  */
@@ -5169,6 +5206,8 @@ resolve_typebound_generic_call (gfc_expr* e, const
 {
   gfc_typebound_proc* genproc;
   const char* genname;
+  gfc_symtree *st;
+  gfc_symbol *derived;
 
   gcc_assert (e->expr_type == EXPR_COMPCALL);
   genname = e->value.compcall.name;
@@ -5236,6 +5275,19 @@ resolve_typebound_generic_call (gfc_expr* e, const
   return FAILURE;
 
 success:
+  /* Make sure that we have the right specific instance for the name.  */
+  genname = e->value.compcall.tbp->u.specific->name;
+
+  /* Is the symtree name a "unique name".  */
+  if (*genname == '@')
+    genname = e->value.compcall.tbp->u.specific->n.sym->name;
+
+  derived = get_declared_from_expr (NULL, NULL, e);
+
+  st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where);
+  if (st)
+    e->value.compcall.tbp = st->n.tb;
+
   return SUCCESS;
 }
 
@@ -5343,39 +5395,7 @@ resolve_compcall (gfc_expr* e, const char **name)
 }
 
 
-/* Get the ultimate declared type from an expression.  In addition,
-   return the last class/derived type reference and the copy of the
-   reference list.  */
-static gfc_symbol*
-get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
-			gfc_expr *e)
-{
-  gfc_symbol *declared;
-  gfc_ref *ref;
 
-  declared = NULL;
-  *class_ref = NULL;
-  *new_ref = gfc_copy_ref (e->ref);
-  for (ref = *new_ref; ref; ref = ref->next)
-    {
-      if (ref->type != REF_COMPONENT)
-	continue;
-
-      if (ref->u.c.component->ts.type == BT_CLASS
-	    || ref->u.c.component->ts.type == BT_DERIVED)
-	{
-	  declared = ref->u.c.component->ts.u.derived;
-	  *class_ref = ref;
-	}
-    }
-
-  if (declared == NULL)
-    declared = e->symtree->n.sym->ts.u.derived;
-
-  return declared;
-}
-
-
 /* Resolve a typebound function, or 'method'. First separate all
    the non-CLASS references by calling resolve_compcall directly.  */
 
@@ -5423,11 +5443,8 @@ resolve_typebound_function (gfc_expr* e)
   e->value.function.esym = NULL;
   e->symtree = st;
 
-  if (class_ref)  
-    {
-      gfc_free_ref_list (class_ref->next);
-      e->ref = new_ref;
-    }
+  if (new_ref)  
+    e->ref = new_ref;
 
   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (e, "$vptr");
@@ -5496,11 +5513,8 @@ resolve_typebound_subroutine (gfc_code *code)
   code->expr1->value.function.esym = NULL;
   code->expr1->symtree = st;
 
-  if (class_ref)  
-    {
-      gfc_free_ref_list (class_ref->next);
-      code->expr1->ref = new_ref;
-    }
+  if (new_ref)
+    code->expr1->ref = new_ref;
 
   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (code->expr1, "$vptr");

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Janus Weil]

2010/5/17 Tobias Burnus <burnus@net-b.de>:
>> It is interesting if one follows "class_ref" in
>> resolve_typebound_subroutine. Before
>>   resolve_typebound_call (code, &name);
>> it is still "type = REF_COMPONENT" but afterwards it is type = 2893287512.
>>
>
> Which makes sense:
>
> resolve_typebound_subroutine (gfc_code *code)
> {
>  declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1);
>  resolve_typebound_call (code, &name);
>  if (class_ref)
>
> and
>
> resolve_typebound_call (gfc_code* c, const char **name)
> {
>  gfc_free_expr (c->expr1);
>
> Thus, it is not surprising that it won't work if one frees c->expr1 -
> and then uses c->expr1->ref == class_ref later.


... which means we should probably just forget about the
"gfc_free_ref_list", since the whole expression has already been
freed. Adding the following to Paul's patch makes the ICEs go away:


@@ -5423,11 +5443,8 @@ resolve_typebound_function (gfc_expr* e)
   e->value.function.esym = NULL;
   e->symtree = st;

-  if (class_ref)
-    {
-      gfc_free_ref_list (class_ref->next);
-      e->ref = new_ref;
-    }
+  if (new_ref)
+    e->ref = new_ref;

   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (e, "$vptr");
@@ -5496,11 +5513,8 @@ resolve_typebound_subroutine (gfc_code *code)
   code->expr1->value.function.esym = NULL;
   code->expr1->symtree = st;

-  if (class_ref)
-    {
-      gfc_free_ref_list (class_ref->next);
-      code->expr1->ref = new_ref;
-    }
+  if (new_ref)
+    code->expr1->ref = new_ref;

   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (code->expr1, "$vptr");


The full patch can be found in the attachment. It regtests without
failures. Paul, do you think this is ok? If yes, should I go ahead and
commit it?

Cheers,
Janus

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Daniel Franke]

On Monday 17 May 2010 23:39:44 Tobias Burnus wrote:
> Tobias Burnus wrote:
> > It is interesting if one follows "class_ref" in
> > resolve_typebound_subroutine. Before
> > 
> >   resolve_typebound_call (code, &name);
> > 
> > it is still "type = REF_COMPONENT" but afterwards it is type =
> > 2893287512.
> 
> Which makes sense:
> 
> resolve_typebound_subroutine (gfc_code *code)
> {
>   declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1);
>   resolve_typebound_call (code, &name);
>   if (class_ref)
> 
> and
> 
> resolve_typebound_call (gfc_code* c, const char **name)
> {
>   gfc_free_expr (c->expr1);
> 
> Thus, it is not surprising that it won't work if one frees c->expr1 -
> and then uses c->expr1->ref == class_ref later.


This rings a small bell, PR40994 may be related here.

It's an ICE gfc_undo_symbols after dealing with a  typebound procedure. It 
appears that gfc_undo_symbols tries to free something that was freed before?!

Just to mention it.

	Daniel

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Tobias Burnus]

Tobias Burnus wrote:
> It is interesting if one follows "class_ref" in
> resolve_typebound_subroutine. Before
>   resolve_typebound_call (code, &name);
> it is still "type = REF_COMPONENT" but afterwards it is type = 2893287512.
>   

Which makes sense:

resolve_typebound_subroutine (gfc_code *code)
{
  declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1);
  resolve_typebound_call (code, &name);
  if (class_ref)

and

resolve_typebound_call (gfc_code* c, const char **name)
{
  gfc_free_expr (c->expr1);

Thus, it is not surprising that it won't work if one frees c->expr1 -
and then uses c->expr1->ref == class_ref later.

Tobias

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Tobias Burnus]

Paul Richard Thomas wrote:
>> I don't see that. [...]
>>     
> I just reloaded the patch on a clean tree with the same result.  It
> looks like it ought to be a simple problem but I am blowed if I can
> see what it is.  I'll have another peek tomorrow.
>   

I can reproduce both: Regtesting does not show anything but using
valgrind I see the following - which regards

  if (class_ref)
    {
      gfc_free_ref_list (class_ref->next);  // <<< this is line 5484

Using a recent trunk build without the patch works, i.e. valgrind shows
no such error. The crucial line seems to be:
    call a%a%scal(d,info)
and it even shows the valgrind error when one has commented out the TBP
block of "type :: s_sparse_mat".

It is interesting if one follows "class_ref" in
resolve_typebound_subroutine. Before
  resolve_typebound_call (code, &name);
it is still "type = REF_COMPONENT" but afterwards it is type = 2893287512.

==16987== Invalid read of size 8
==16987==    at 0x5298FA: resolve_code (resolve.c:5484)
==16987==    by 0x52B3F2: resolve_codes (resolve.c:12792)
==16987==    by 0x52B2FF: resolve_codes (resolve.c:12778)
==16987==    by 0x51EBF4: gfc_resolve (resolve.c:12819)
==16987==    by 0x5135D7: gfc_parse_file (parse.c:4292)
==16987==    by 0x548D97: gfc_be_parse_file (f95-lang.c:239)
==16987==    by 0x835996: toplev_main (toplev.c:1049)
==16987==    by 0x6560B7C: (below main) (in /lib64/libc-2.11.1.so)
==16987==  Address 0x7220d60 is 368 bytes inside a block of size 376 free'd
==16987==    at 0x4C25F7B: free (in
/usr/lib64/valgrind/vgpreload_memcheck-amd64-linux.so)
==16987==    by 0x4D5C5E: gfc_free_ref_list (expr.c:582)
==16987==    by 0x522C97: resolve_typebound_static (resolve.c:5118)
==16987==    by 0x5262DF: resolve_typebound_call (resolve.c:5287)
==16987==    by 0x5298CA: resolve_code (resolve.c:5475)
==16987==    by 0x52B3F2: resolve_codes (resolve.c:12792)
==16987==    by 0x52B2FF: resolve_codes (resolve.c:12778)
==16987==    by 0x51EBF4: gfc_resolve (resolve.c:12819)
==16987==    by 0x5135D7: gfc_parse_file (parse.c:4292)
==16987==    by 0x548D97: gfc_be_parse_file (f95-lang.c:239)
==16987==    by 0x835996: toplev_main (toplev.c:1049)
==16987==    by 0x6560B7C: (below main) (in /lib64/libc-2.11.1.so)

Tobias

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Paul Richard Thomas]

Dominique,


> I don't see that. Are you sure that you don't have some left-over
> from other patches?

I just reloaded the patch on a clean tree with the same result.  It
looks like it ought to be a simple problem but I am blowed if I can
see what it is.  I'll have another peek tomorrow.

Cheers

Paul

Re: [Patch, fortran] PR43945 - [OOP] Derived type with GENERIC: resolved to the wrong specific TBP

[Dominique Dhumieres]

Paul,

I have your patch applied to my tree for some time now without
side effects.

> I am finally in a position to commit this one but, on a different
> system, it has started segfaulting on my old friend
> dynamic_dispatch_5.f03 (and on coarray_8.f90). ...

I don't see that. Are you sure that you don't have some left-over
from other patches?

Cheers,

Dominique