diff mbox

PR fortran/78300 -- class procedure as actual arg

Message ID 20161113221255.GA16971@troutmask.apl.washington.edu
State New
Headers show

Commit Message

Steve Kargl Nov. 13, 2016, 10:12 p.m. UTC 
The attach patch allows a procedure with a class result to
be an actual argument to subprogram where the dummy argument
expected to be a class.  OK to commit?

2016-11-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78300
	* resolve.c (resolve_fl_var_and_proc): Allow class procedure an
	actual argument.


2016-11-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78300
	* gfortran.dg/pr78300.f90: New test.

Comments

Janus Weil Nov. 14, 2016, 8:56 a.m. UTC | #1 
Hi Steve,

> The attach patch allows a procedure with a class result to
> be an actual argument to subprogram where the dummy argument
> expected to be a class.  OK to commit?

that patch actually does not look quite right to me. Does it survive a regtest?

I think one should rather check why the class_ok attribute is not set
in the first place, any maybe apply a fix in gfc_build_class_symbol.

Cheers,
Janus
diff mbox

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 242362)
+++ gcc/fortran/resolve.c	(working copy)
@@ -11705,7 +11705,8 @@  resolve_fl_var_and_proc (gfc_symbol *sym
       /* Assume that use associated symbols were checked in the module ns.
 	 Class-variables that are associate-names are also something special
 	 and excepted from the test.  */
-      if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
+      if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->attr.dummy
+	  && !sym->assoc)
 	{
 	  gfc_error ("CLASS variable %qs at %L must be dummy, allocatable "
 		     "or pointer", sym->name, &sym->declared_at);
Index: gcc/testsuite/gfortran.dg/pr78300.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78300.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78300.f90	(working copy)
@@ -0,0 +1,38 @@ 
+! { dg-do compile }
+module gfc_base
+
+   implicit none
+
+   integer, parameter:: INTD=4
+   integer, parameter:: INTL=8
+   integer(INTD), parameter :: GFC_FALSE=0
+
+   type gfc_cont_elem_t
+      class(*), pointer, private:: value_p=>NULL()
+      integer(INTD), private:: alloc=GFC_FALSE
+      contains
+         procedure, public:: construct=>ContElemConstruct
+   end type gfc_cont_elem_t
+
+   abstract interface
+      function gfc_copy_i(obj,ierr) result(clone)
+         import:: INTD
+         class(*), pointer:: clone
+         class(*), intent(in):: obj
+         integer(INTD), intent(out), optional:: ierr
+      end function gfc_copy_i
+   end interface
+
+   private ContElemConstruct
+
+   contains
+
+      subroutine ContElemConstruct(this,obj,ierr,assoc_only,copy_constr_func)
+         class(gfc_cont_elem_t), intent(inout):: this
+         class(*), target, intent(in):: obj
+         integer(INTD), intent(out), optional:: ierr
+         logical, intent(in), optional:: assoc_only
+         procedure(gfc_copy_i), optional:: copy_constr_func
+      end subroutine ContElemConstruct
+
+ end module gfc_base