From c3f35a0f3788ed6f0a90fc4fae692fb6f9497c01 Mon Sep 17 00:00:00 2001 From: burnus Date: Sat, 10 Mar 2012 08:18:31 +0000 Subject: [PATCH] 2012-03-10 Tobias Burnus PR fortran/52469 * trans-types.c (gfc_get_function_type): Handle backend_decl of a procedure pointer. 2012-03-10 Tobias Burnus PR fortran/52469 * gfortran.dg/proc_ptr_34.f90 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@185170 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-types.c | 6 ++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/proc_ptr_34.f90 | 79 +++++++++++++++++++++++++++++++ 4 files changed, 95 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_34.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 48670876a39..b295c6684ba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-03-10 Tobias Burnus + + PR fortran/52469 + * trans-types.c (gfc_get_function_type): Handle backend_decl + of a procedure pointer. + 2012-02-29 Paul Thomas PR fortran/52386 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 2579e2356ab..dfd73da44e1 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2673,7 +2673,11 @@ gfc_get_function_type (gfc_symbol * sym) || sym->attr.flavor == FL_PROGRAM); if (sym->backend_decl) - return TREE_TYPE (sym->backend_decl); + { + if (sym->attr.proc_pointer) + return TREE_TYPE (TREE_TYPE (sym->backend_decl)); + return TREE_TYPE (sym->backend_decl); + } alternate_return = 0; typelist = NULL; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0f56e01d32a..04a2f9e45b6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-03-10 Tobias Burnus + + PR fortran/52469 + * gfortran.dg/proc_ptr_34.f90: New. + 2012-03-07 Jason Merrill PR c++/52521 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_34.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_34.f90 new file mode 100644 index 00000000000..6226414b819 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_34.f90 @@ -0,0 +1,79 @@ +! { dg-do compile } +! +! PR fortran/52469 +! +! This was failing as the DECL of the proc pointer "func" +! was used for the interface of the proc-pointer component "my_f_ptr" +! rather than the decl of the proc-pointer target +! +! Contributed by palott@gmail.com +! + +module ExampleFuncs + implicit none + + ! NOTE: "func" is a procedure pointer! + pointer :: func + interface + function func (z) + real :: func + real, intent (in) :: z + end function func + end interface + + type Contains_f_ptr + procedure (func), pointer, nopass :: my_f_ptr + end type Contains_f_ptr +contains + +function f1 (x) + real :: f1 + real, intent (in) :: x + + f1 = 2.0 * x + + return +end function f1 + +function f2 (x) + real :: f2 + real, intent (in) :: x + + f2 = 3.0 * x**2 + + return +end function f2 + +function fancy (func, x) + real :: fancy + real, intent (in) :: x + + interface AFunc + function func (y) + real :: func + real, intent (in) ::y + end function func + end interface AFunc + + fancy = func (x) + 3.3 * x +end function fancy + +end module ExampleFuncs + + +program test_proc_ptr + use ExampleFuncs + implicit none + + type (Contains_f_ptr), dimension (2) :: NewType + + !NewType(1) % my_f_ptr => f1 + NewType(2) % my_f_ptr => f2 + + !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0) + write (6, *) NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0' + + stop +end program test_proc_ptr + +! { dg-final { cleanup-modules "examplefuncs" } } -- 2.11.0