This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] PR fortran/89647 -- Allow host associated procedure to be a binding target


The attached patch fixes PR fortran/89647, and has been
regression tested on x86_64-*-freebsd.

If a procedure is made accessible by host association, the
that procedure can be used as binding target.  During the
resolution of a type bound procedure, gfortran needs to
check the parent namespace for a procedure before it fails.

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

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

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

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

OK to commit?

-- 
Steve
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 274320)
+++ gcc/fortran/resolve.c	(working copy)
@@ -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;
 	}
     }
Index: gcc/testsuite/gfortran.dg/pr89647.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89647.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89647.f90	(working copy)
@@ -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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]