diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-04 12:28:43 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-04 12:28:43 +0000 |
| commit | eee4a6d85d3a9f24b48a26fe6455807c53bad76b (patch) | |
| tree | c43ddb5d7d47d313a9915996d986aa2ca0533755 /gcc/testsuite | |
| parent | 9ee8efb930e81d5d60b35597d24745082e5acea3 (diff) | |
| download | gcc-eee4a6d85d3a9f24b48a26fe6455807c53bad76b.tar.gz | |
2009-07-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/40593
* interface.c (compare_actual_formal): Take care of proc-pointer-valued
functions as actual arguments.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* resolve.c (resolve_specific_f0): Use the correct ts.
2009-07-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/40593
* gfortran.dg/proc_ptr_result_6.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149227 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/testsuite')
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 | 51 |
2 files changed, 56 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 84e7fc18870..fdc685500c0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-07-04 Janus Weil <janus@gcc.gnu.org> + + PR fortran/40593 + * gfortran.dg/proc_ptr_result_6.f90: New. + 2009-07-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> * gcc.dg/framework-2.c: Adjust testcase to pass. diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 new file mode 100644 index 00000000000..c9e1a8b067a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! +! PR 40593: Proc-pointer returning function as actual argument +! +! Original test case by Tobias Burnus <burnus@gcc.gnu.org> +! Modified by Janus Weil + +module m +contains + subroutine sub(a) + integer :: a + a = 42 + end subroutine + integer function func() + func = 42 + end function +end module m + +program test + use m + implicit none + call caller1(getPtr1()) + call caller2(getPtr2()) + call caller3(getPtr2()) +contains + subroutine caller1(s) + procedure(sub) :: s + integer :: b + call s(b) + if (b /= 42) call abort() + end subroutine + subroutine caller2(f) + procedure(integer) :: f + if (f() /= 42) call abort() + end subroutine + subroutine caller3(f) + procedure(func),pointer :: f + if (f() /= 42) call abort() + end subroutine + function getPtr1() + procedure(sub), pointer :: getPtr1 + getPtr1 => sub + end function + function getPtr2() + procedure(func), pointer :: getPtr2 + getPtr2 => func + end function +end program test + +! { dg-final { cleanup-modules "m" } } + |