From e6a5e544f7a09a9de801024cc2cb4e279a81ceb7 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 28 Apr 2009 18:27:27 +0200 Subject: [PATCH] re PR fortran/39946 (PROCEDURE statements: interface with RESULT variable) 2009-04-28 Janus Weil PR fortran/39946 * resolve.c (resolve_symbol): Correctly copy the interface of a PROCEDURE statement if the interface involves a RESULT variable. 2009-04-28 Janus Weil PR fortran/39946 * gfortran.dg/proc_ptr_16.f90: New. From-SVN: r146905 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 5 ++++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/proc_ptr_16.f90 | 20 ++++++++++++++++++++ 4 files changed, 35 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6db33255619..e60eca618d3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-04-28 Janus Weil + + PR fortran/39946 + * resolve.c (resolve_symbol): Correctly copy the interface of a + PROCEDURE statement if the interface involves a RESULT variable. + 2009-04-28 Janus Weil PR fortran/39930 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 75078699168..fe79e4a6703 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9244,7 +9244,10 @@ resolve_symbol (gfc_symbol *sym) if (ifc->attr.intrinsic) resolve_intrinsic (ifc, &ifc->declared_at); - sym->ts = ifc->ts; + if (ifc->result) + sym->ts = ifc->result->ts; + else + sym->ts = ifc->ts; sym->ts.interface = ifc; sym->attr.function = ifc->attr.function; sym->attr.subroutine = ifc->attr.subroutine; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ebfcff932e9..024998b4469 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-04-28 Janus Weil + + PR fortran/39946 + * gfortran.dg/proc_ptr_16.f90: New. + 2009-04-28 Steve Ellcey * testsuite/gcc.target/ia64/sync-1.c: Check for cmpxchg8 only if diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_16.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90 new file mode 100644 index 00000000000..904b550b5e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! +! PR 39946: PROCEDURE statements: interface with RESULT variable +! +! Original test case by Juergen Reuter +! Modified by Janus Weil + + procedure(prc_is_allowed), pointer :: fptr + + interface + function prc_is_allowed (flv, hel, col) result (is_allowed) + logical :: is_allowed + integer, intent(in) :: flv, hel, col + end function prc_is_allowed + end interface + + fptr => prc_is_allowed + +end +