[[Patch,fortran] PR86863 - [OOP][F2008] type-bound module procedure name not recognized

Message ID CAGkQGi+j6Q2iDrg8vv-1EDSoOYHEMZyWyiHJ6_yqzcTHdP3o2A@mail.gmail.com
State New
Headers show
Series
  • [[Patch,fortran] PR86863 - [OOP][F2008] type-bound module procedure name not recognized
Related show

Commit Message

Paul Richard Thomas Aug. 12, 2018, 3:30 p.m.
I have cast around for a better way to fix this bug but have not come
up with anything. Although brute force, the patch does the job. The
testcase has been extended to include a MODULE PROCEDURE in a
submodule, which I think must have been the contributor's original
intention.

Bootstrapped and regtested on FC28/x86_64 - OK for trunk?

Paul

2017-08-12  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/86863
    * resolve.c (resolve_typebound_call): If the TBP is not marked
    as a subroutine, check the specific symbol.

2017-08-12  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/86863
    * gfortran.dg/submodule_32.f08: New test.

Patch

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 263494)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_typebound_call (gfc_code* c, con
*** 6266,6274 ****
    /* Check that's really a SUBROUTINE.  */
    if (!c->expr1->value.compcall.tbp->subroutine)
      {
!       gfc_error ("%qs at %L should be a SUBROUTINE",
! 		 c->expr1->value.compcall.name, &c->loc);
!       return false;
      }
  
    if (!check_typebound_baseobject (c->expr1))
--- 6266,6282 ----
    /* Check that's really a SUBROUTINE.  */
    if (!c->expr1->value.compcall.tbp->subroutine)
      {
!       if (!c->expr1->value.compcall.tbp->is_generic
! 	  && c->expr1->value.compcall.tbp->u.specific
! 	  && c->expr1->value.compcall.tbp->u.specific->n.sym
! 	  && c->expr1->value.compcall.tbp->u.specific->n.sym->attr.subroutine)
! 	c->expr1->value.compcall.tbp->subroutine = 1;
!       else
! 	{
! 	  gfc_error ("%qs at %L should be a SUBROUTINE",
! 		     c->expr1->value.compcall.name, &c->loc);
! 	  return false;
! 	}
      }
  
    if (!check_typebound_baseobject (c->expr1))
Index: gcc/testsuite/gfortran.dg/submodule_32.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_32.f08	(nonexistent)
--- gcc/testsuite/gfortran.dg/submodule_32.f08	(working copy)
***************
*** 0 ****
--- 1,62 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR86863, where the Type Bound Procedures were
+ ! not flagged as subroutines thereby causing an error at the call
+ ! statements.
+ !
+ ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+ !
+ module foo
+   implicit none
+   integer :: flag = 0
+   type bar
+   contains
+     procedure, nopass :: foobar
+     procedure, nopass :: barfoo
+   end type
+ contains
+   subroutine foobar
+     flag = 1
+   end subroutine
+   subroutine barfoo
+     flag = 0
+   end subroutine
+ end module
+ 
+ module foobartoo
+   implicit none
+   interface
+     module subroutine set(object)
+       use foo
+       implicit none
+       type(bar) object
+     end subroutine
+     module subroutine unset(object)
+       use foo
+       implicit none
+       type(bar) object
+     end subroutine
+   end interface
+ contains
+   module procedure unset
+     use foo, only : bar
+     call object%barfoo
+   end procedure
+ end module
+ 
+ submodule(foobartoo) subfoobar
+ contains
+   module procedure set
+     use foo, only : bar
+     call object%foobar
+   end procedure
+ end submodule
+ 
+   use foo
+   use foobartoo
+   type(bar) :: obj
+   call set(obj)
+   if (flag .ne. 1) stop 1
+   call unset(obj)
+   if (flag .ne. 0) stop 2
+ end