+2009-10-20 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/41706
+ * resolve.c (resolve_arg_exprs): New function.
+ (resolve_class_compcall): Call the above.
+ (resolve_class_typebound_call): The same.
+
2009-10-19 Janus Weil <janus@gcc.gnu.org>
PR fortran/41586
}
+/* Resolve the argument expressions so that any arguments expressions
+ that include class methods are resolved before the current call.
+ This is necessary because of the static variables used in CLASS
+ method resolution. */
+static void
+resolve_arg_exprs (gfc_actual_arglist *arg)
+{
+ /* Resolve the actual arglist expressions. */
+ for (; arg; arg = arg->next)
+ {
+ if (arg->expr)
+ gfc_resolve_expr (arg->expr);
+ }
+}
+
+
/* Resolve a CLASS typebound function, or 'method'. */
static gfc_try
resolve_class_compcall (gfc_expr* e)
{
gfc_free_ref_list (new_ref);
return resolve_compcall (e, true);
- }
+ }
+
+ /* Resolve the argument expressions, */
+ resolve_arg_exprs (e->value.function.actual);
/* Get the data component, which is of the declared type. */
derived = declared->components->ts.u.derived;
return resolve_typebound_call (code);
}
+ /* Resolve the argument expressions, */
+ resolve_arg_exprs (code->ext.actual);
+
/* Get the data component, which is of the declared type. */
derived = declared->components->ts.u.derived;
+2009-10-20 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/41706
+ * gfortran.dg/class_9 : New test.
+
2009-10-19 Jakub Jelinek <jakub@redhat.com>
* gcc.dg/raw-string-1.c: New test.
--- /dev/null
+! { dg-do run }
+! Test the fix for PR41706, in which arguments of class methods that
+! were themselves class methods did not work.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+!
+module m
+type :: t
+ real :: v = 1.5
+contains
+ procedure, nopass :: a
+ procedure, nopass :: b
+ procedure, pass :: c
+end type
+
+contains
+
+ real function a (x)
+ real :: x
+ a = 2.*x
+ end function
+
+ real function b (x)
+ real :: x
+ b = 3.*x
+ end function
+
+ real function c (x)
+ class (t) :: x
+ c = 4.*x%v
+ end function
+
+ subroutine s (x)
+ class(t) :: x
+ real :: r
+ r = x%a (1.1) ! worked
+ if (r .ne. a (1.1)) call abort
+
+ r = x%a (b (1.2)) ! worked
+ if (r .ne. a(b (1.2))) call abort
+
+ r = b ( x%a (1.3)) ! worked
+ if (r .ne. b(a (1.3))) call abort
+
+ r = x%a(x%b (1.4)) ! failed
+ if (r .ne. a(b (1.4))) call abort
+
+ r = x%a(x%c ()) ! failed
+ if (r .ne. a(c (x))) call abort
+
+ end subroutine
+
+end
+
+ use m
+ class(t),allocatable :: x
+ allocate(x)
+ call s (x)
+end
+! { dg-final { cleanup-modules "m" } }