From f99098233b944542b3f78de9da395f220fe9d0cf Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Thu, 18 Jun 2009 10:09:40 +0200 Subject: [PATCH] re PR fortran/40451 ([F03] procedure pointer assignment rejected) 2009-06-18 Janus Weil PR fortran/40451 * resolve.c (resolve_contained_fntype): Prevent implicit typing for procedures with explicit interface. * symbol.c (gfc_check_function_type): Ditto. 2009-06-18 Janus Weil PR fortran/40451 * gfortran.dg/proc_ptr_result_4.f90: New. From-SVN: r148652 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/resolve.c | 2 +- gcc/fortran/symbol.c | 2 +- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 | 16 ++++++++++++++++ 5 files changed, 30 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 39bc27f05207..d6a608285b92 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-06-18 Janus Weil + + PR fortran/40451 + * resolve.c (resolve_contained_fntype): Prevent implicit typing for + procedures with explicit interface. + * symbol.c (gfc_check_function_type): Ditto. + 2009-06-16 Ian Lance Taylor * decl.c (build_struct): Rewrite loop over constructor elements. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3a670423d7f3..4117d80f994a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -347,7 +347,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) return; /* Try to find out of what the return type is. */ - if (sym->result->ts.type == BT_UNKNOWN) + if (sym->result->ts.type == BT_UNKNOWN && sym->result->ts.interface == NULL) { t = gfc_set_default_type (sym->result, 0, ns); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 326d73e3ebfa..71062fb08ca3 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -317,7 +317,7 @@ gfc_check_function_type (gfc_namespace *ns) if (!proc->attr.contained || proc->result->attr.implicit_type) return; - if (proc->result->ts.type == BT_UNKNOWN) + if (proc->result->ts.type == BT_UNKNOWN && proc->result->ts.interface == NULL) { if (gfc_set_default_type (proc->result, 0, gfc_current_ns) == SUCCESS) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c20d83941ddb..c16ecd047955 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-06-18 Janus Weil + + PR fortran/40451 + * gfortran.dg/proc_ptr_result_4.f90: New. + 2009-06-17 Adam Nemet * gcc.c-torture/execute/bitfld-5.c: New test. diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 new file mode 100644 index 000000000000..97e67e558efc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR 40451: [F03] procedure pointer assignment rejected +! +! Contributed by Tobias Burnus + +contains + + function f() + intrinsic :: sin + procedure(sin), pointer :: f + f => sin + end function f + +end + -- 2.43.5