diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-01-27 21:11:51 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-01-27 21:11:51 +0100 |
| commit | 8c6cb782a355e540036b38f8124a1870612c4950 (patch) | |
| tree | 552e858d37f35a62753f9f3b345244a4793999ba /gcc | |
| parent | bea3da64d61c31335b9bf700aeb836dd93558793 (diff) | |
| download | gcc-8c6cb782a355e540036b38f8124a1870612c4950.zip gcc-8c6cb782a355e540036b38f8124a1870612c4950.tar.gz gcc-8c6cb782a355e540036b38f8124a1870612c4950.tar.bz2 | |
re PR fortran/52022 (Wrong-code with procedures passed as actual argument)
2012-01-27 Tobias Burnus <burnus@net-b.de>
PR fortran/52022
* trans-expr.c (gfc_conv_procedure_call): Fix passing
of functions, which return allocatables.
2012-01-27 Tobias Burnus <burnus@net-b.de>
PR fortran/52022
* gfortran.dg/dummy_procedure_7.f90: New.
From-SVN: r183643
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 3 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dummy_procedure_7.f90 | 65 |
4 files changed, 78 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b54ad3d..b1e9402 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,11 @@ 2012-01-27 Tobias Burnus <burnus@net-b.de> + PR fortran/52022 + * trans-expr.c (gfc_conv_procedure_call): Fix passing + of functions, which return allocatables. + +2012-01-27 Tobias Burnus <burnus@net-b.de> + PR fortran/52016 * resolve.c (resolve_formal_arglist): Fix elemental constraint checks for polymorphic dummies also for diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 250f30f..7543149 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3662,7 +3662,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, || (fsym->attr.proc_pointer && e->expr_type == EXPR_VARIABLE && gfc_is_proc_ptr_comp (e, NULL)) - || fsym->attr.allocatable)) + || (fsym->attr.allocatable + && fsym->attr.flavor != FL_PROCEDURE))) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c64db73..7ebce8dd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/52022 + * gfortran.dg/dummy_procedure_7.f90: New. + 2012-01-27 Andreas Schwab <schwab@linux-m68k.org> * g++.dg/cpp0x/constexpr-rom.C: Don't add -G0 on *-*-darwin* diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90 new file mode 100644 index 0000000..32cd65a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90 @@ -0,0 +1,65 @@ +! { dg-do run } +! +! PR fortran/52022 +! + +module check + integer, save :: icheck = 0 +end module check + +module t +implicit none + contains +subroutine sol(cost) + use check + interface + function cost(p) result(y) + double precision,dimension(:) :: p + double precision,dimension(:),allocatable :: y + end function cost + end interface + + if (any (cost([1d0,2d0]) /= [2.d0, 4.d0])) call abort () + icheck = icheck + 1 +end subroutine + +end module t + +module tt + procedure(cost1),pointer :: pcost +contains + subroutine init() + pcost=>cost1 + end subroutine + + function cost1(x) result(y) + double precision,dimension(:) :: x + double precision,dimension(:),allocatable :: y + allocate(y(2)) + y=2d0*x + end function cost1 + + + + function cost(x) result(y) + double precision,dimension(:) :: x + double precision,dimension(:),allocatable :: y + allocate(y(2)) + y=pcost(x) + end function cost +end module + +program test + use tt + use t + use check + implicit none + + call init() + if (any (cost([3.d0,7.d0]) /= [6.d0, 14.d0])) call abort () + if (icheck /= 0) call abort () + call sol(cost) + if (icheck /= 1) call abort () +end program test + +! { dg-final { cleanup-modules "t tt check" } } |