aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2018-08-23 06:27:54 +0000
committerPaul Thomas <pault@gcc.gnu.org>2018-08-23 06:27:54 +0000
commit6ab6c0c3bb09707f993a748c67087838f6b7d5f9 (patch)
tree7f33595b13c10f6fd3bd43c4e1e90953ca66ec41
parentba7a2ad8bdc51dbfaaa1a83b24b0417691a5a80d (diff)
downloadgcc-6ab6c0c3bb09707f993a748c67087838f6b7d5f9.zip
gcc-6ab6c0c3bb09707f993a748c67087838f6b7d5f9.tar.gz
gcc-6ab6c0c3bb09707f993a748c67087838f6b7d5f9.tar.bz2
re PR fortran/86863 ([OOP][F2008] type-bound module procedure name not recognized)
2017-08-23 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-23 Paul Thomas <pault@gcc.gnu.org> PR fortran/86863 * gfortran.dg/submodule_32.f08: New test. From-SVN: r263799
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/resolve.c14
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/submodule_32.f0862
4 files changed, 84 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 56e9c95..4cbdc68 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2017-08-23 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.
+
2018-08-22 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.texi: Mention that asynchronous I/O does
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4ad4dcf..43a8470 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6266,9 +6266,17 @@ resolve_typebound_call (gfc_code* c, const char **name, bool *overridable)
/* 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 (!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))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8e70d05..d011aa7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-08-23 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/86863
+ * gfortran.dg/submodule_32.f08: New test.
+
2018-08-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/86935
diff --git a/gcc/testsuite/gfortran.dg/submodule_32.f08 b/gcc/testsuite/gfortran.dg/submodule_32.f08
new file mode 100644
index 0000000..529015b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_32.f08
@@ -0,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