+2009-06-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/39850
+ * interface.c (gfc_compare_interfaces): Take care of implicit typing
+ when checking the function attribute. Plus another bugfix.
+ (compare_parameter): Set attr.function and attr.subroutine according
+ to the usage of a procedure as actual argument.
+
2009-06-20 Tobias Burnus <burnus@net-b.de>
PR fortran/40452
{
gfc_formal_arglist *f1, *f2;
- if (s1->attr.function && !s2->attr.function)
+ if (s1->attr.function && (s2->attr.subroutine
+ || (!s2->attr.function && s2->ts.type == BT_UNKNOWN
+ && gfc_get_default_type (s2->name, s2->ns)->type == BT_UNKNOWN)))
{
if (errmsg != NULL)
snprintf (errmsg, err_len, "'%s' is not a function", s2->name);
"of '%s'", s2->name);
return 0;
}
- if (s1->attr.if_source == IFSRC_DECL)
- return 1;
}
if (s1->attr.if_source == IFSRC_UNKNOWN
if (actual->ts.type == BT_PROCEDURE)
{
char err[200];
+ gfc_symbol *act_sym = actual->symtree->n.sym;
if (formal->attr.flavor != FL_PROCEDURE)
{
return 0;
}
- if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1, err,
+ if (!gfc_compare_interfaces (formal, act_sym, 0, 1, err,
sizeof(err)))
{
if (where)
return 0;
}
+ if (formal->attr.function && !act_sym->attr.function)
+ gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at);
+
+ if (formal->attr.subroutine && !act_sym->attr.subroutine)
+ gfc_add_subroutine (&act_sym->attr, act_sym->name,
+ &act_sym->declared_at);
+
return 1;
}
+2009-06-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/39850
+ * gfortran.dg/interface_19.f90: Add 'cleanup-modules'.
+ * gfortran.dg/interface_20.f90: Ditto.
+ * gfortran.dg/interface_21.f90: Ditto.
+ * gfortran.dg/interface_22.f90: Ditto.
+ * gfortran.dg/interface_30.f90: New.
+ * gfortran.dg/proc_ptr_11.f90: Fix invalid test case.
+
2009-06-21 Uros Bizjak <ubizjak@gmail.com>
* gcc.dg/tree-ssa/fre-vce-1.c: Cleanup "fre" tree dump.
call sub()
call sub(dcos)
end
+
+! { dg-final { cleanup-modules "m" } }
+
intrinsic cos
call sub(cos) ! { dg-error "wrong number of arguments" }
end
+
+! { dg-final { cleanup-modules "m" } }
+
EXTERNAL foo ! implicit interface is undefined
call sub(foo) ! { dg-error "is not a function" }
end
+
+! { dg-final { cleanup-modules "m" } }
+
module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
end interface swap
end module gswap
+
+! { dg-final { cleanup-modules "foo g gswap" } }
+
--- /dev/null
+! { dg-do compile }
+!
+! PR39850: Too strict checking for procedures as actual argument
+!
+! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+real function func()
+ print *,"func"
+ func = 42.0
+end function func
+
+program test
+ external func1,func2,func3,func4 ! subroutine or implicitly typed real function
+ call sub1(func1)
+ call sub2(func2)
+ call sub1(func3)
+ call sub2(func3) ! { dg-error "Type mismatch in argument" }
+ call sub2(func4)
+ call sub1(func4) ! { dg-error "Interface mismatch in dummy procedure" }
+contains
+ subroutine sub1(a1)
+ interface
+ real function a1()
+ end function
+ end interface
+ print *, a1()
+ end subroutine sub1
+ subroutine sub2(a2)
+ interface
+ subroutine a2
+ end subroutine
+ end interface
+ call a2()
+ end subroutine
+end
+
end function add
integer function f(x)
- integer :: x
+ integer,intent(in) :: x
f = 317 + x
end function