re PR fortran/89647 (Host associated procedure unable to be used as binding target)

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89647
	resolve.c (resolve_typebound_procedure): Allow host associated
	procedure to be a binding target.  While here, wrap long line.

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89647
	* gfortran.dg/pr89647.f90: New test.

From-SVN: r274393

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d5e44a77d5d815880cac8adf6ecaab7a06d850ad..6a908eb88a0fcfc4b162df87cef734d4c4ddb45d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/89647
+       resolve.c (resolve_typebound_procedure): Allow host associated 
+       procedure to be a binding target.  While here, wrap long line.
+
 2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/87993

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d9ad88842718ce5da80c7f04320b031ba38a81e6..bd379b696a0c2e6ce77b03111c276f698621cdd0 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13583,14 +13583,34 @@ resolve_typebound_procedure (gfc_symtree* stree)
     }
   else
     {
+      /* If proc has not been resolved at this point, proc->name may 
+        actually be a USE associated entity. See PR fortran/89647. */
+      if (!proc->resolved
+         && proc->attr.function == 0 && proc->attr.subroutine == 0)
+       {
+         gfc_symbol *tmp;
+         gfc_find_symbol (proc->name, gfc_current_ns->parent, 1, &tmp);
+         if (tmp && tmp->attr.use_assoc)
+           {
+             proc->module = tmp->module;
+             proc->attr.proc = tmp->attr.proc;
+             proc->attr.function = tmp->attr.function;
+             proc->attr.subroutine = tmp->attr.subroutine;
+             proc->attr.use_assoc = tmp->attr.use_assoc;
+             proc->ts = tmp->ts;
+             proc->result = tmp->result;
+           }
+       }
+
       /* Check for F08:C465.  */
       if ((!proc->attr.subroutine && !proc->attr.function)
          || (proc->attr.proc != PROC_MODULE
              && proc->attr.if_source != IFSRC_IFBODY)
          || proc->attr.abstract)
        {
-         gfc_error ("%qs must be a module procedure or an external procedure with"
-                   " an explicit interface at %L", proc->name, &where);
+         gfc_error ("%qs must be a module procedure or an external "
+                    "procedure with an explicit interface at %L",
+                    proc->name, &where);
          goto error;
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6f193c7ab33298ee5196975cff69f32b32ee8a68..e7ec05b55bcb104df165b39db40e920dd2ef7520 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/89647
+       * gfortran.dg/pr89647.f90: New test.
+
 2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/87993

diff --git a/gcc/testsuite/gfortran.dg/pr89647.f90 b/gcc/testsuite/gfortran.dg/pr89647.f90
new file mode 100644 (file)
index 0000000..1d4dc2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89647.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! Code contributed by Ian Harvey  <ian_harvey at bigpond dot com>
+  MODULE m1
+    IMPLICIT NONE
+    PUBLIC :: False
+    PUBLIC :: True
+  CONTAINS
+    FUNCTION False() RESULT(b)
+      LOGICAL :: b
+      b = .FALSE.
+    END FUNCTION False
+    
+    FUNCTION True() RESULT(b)
+      LOGICAL :: b
+      b = .TRUE.
+    END FUNCTION True
+  END MODULE m1
+
+  MODULE m2
+    USE m1
+    IMPLICIT NONE
+    TYPE, ABSTRACT :: t_parent
+    CONTAINS
+      PROCEDURE(False), DEFERRED, NOPASS :: Binding
+    END TYPE t_parent
+  CONTAINS
+    SUBROUTINE s
+      TYPE, EXTENDS(t_parent) :: t_extension
+      CONTAINS
+        PROCEDURE, NOPASS :: Binding => True
+      END TYPE t_extension
+    END SUBROUTINE s
+  END MODULE m2