From 871267e19da270df32c9ffe8be194228a14ddd87 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 17 Oct 2016 17:52:05 +0000 Subject: [PATCH] re PR fortran/61420 ([OOP] type-bound procedure returning a procedure pointer fails to compile) 2016-10-17 Paul Thomas PR fortran/61420 PR fortran/78013 * resolve.c (resolve_variable): Obtain the typespec for a variable expression, when the variable is a function result that is a procedure pointer. 2016-10-17 Paul Thomas PR fortran/61420 PR fortran/78013 * gfortran.dg/proc_ptr_49.f90: New test. From-SVN: r241274 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/resolve.c | 5 +++ gcc/testsuite/ChangeLog | 8 +++- gcc/testsuite/gfortran.dg/proc_ptr_49.f90 | 50 +++++++++++++++++++++++ 4 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_49.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 848b4bde1d8..9b2c5c583f2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2016-10-17 Paul Thomas + + PR fortran/61420 + PR fortran/78013 + * resolve.c (resolve_variable): Obtain the typespec for a + variable expression, when the variable is a function result + that is a procedure pointer. + 2016-10-16 Jerry DeLisle PR fortran/48298 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e03979e1710..87178a41333 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5112,6 +5112,11 @@ resolve_variable (gfc_expr *e) if (sym->ts.type != BT_UNKNOWN) gfc_variable_attr (e, &e->ts); + else if (sym->attr.flavor == FL_PROCEDURE + && sym->attr.function && sym->result + && sym->result->ts.type != BT_UNKNOWN + && sym->result->attr.proc_pointer) + e->ts = sym->result->ts; else { /* Must be a simple variable reference. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 595bd4c8c82..4ba97ca0c2e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-10-17 Paul Thomas + + PR fortran/61420 + PR fortran/78013 + * gfortran.dg/proc_ptr_49.f90: New test. + 2016-09-29 Bernd Edlinger PR target/77308 @@ -895,7 +901,7 @@ 2016-09-29 Sandra Loosemore - * c-c++-common/pr27336.c: Make dependency on + * c-c++-common/pr27336.c: Make dependency on -fdelete-null-pointer-checks explicit. * g++.dg/cpp0x/constexpr-array-ptr10.C: Likewise. * g++.dg/cpp0x/constexpr-nullptr-1.C: Likewise. diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_49.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_49.f90 new file mode 100644 index 00000000000..cb540a4f548 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_49.f90 @@ -0,0 +1,50 @@ +! { dg-do compile } +! +! Tests the fix for PRs 78013 and 61420, both of which gave a +! no IMPLICIT type message for the procedure pointer at assignment. +! +module m + + implicit none + + abstract interface + function I_f() result( r ) + real :: r + end function I_f + end interface + + type, abstract :: a_t + private + procedure(I_f), nopass, pointer :: m_f => null() + contains + private + procedure, pass(this), public :: f => get_f + end type a_t + +contains + + function get_f( this ) result( f_ptr ) ! Error message here. + class(a_t), intent(in) :: this + procedure(I_f), pointer :: f_ptr + f_ptr => this%m_f ! Error here :-) + end function get_f + +end module m + +module test + implicit none + + type functions + contains + procedure, nopass :: get_pf => get_it ! Error here + end type + + class(functions), allocatable :: f + +contains + + function get_it() ! Error message here. + procedure (real), pointer :: get_it + end function + +end module -- 2.30.2