From 8558af5023b91a65d25d2ed32d642f93e09aa28a Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 19 Jan 2019 20:06:41 +0000 Subject: [PATCH] re PR fortran/56789 (Handling of contiguous dummy arguments) 2018-01-19 Thomas Koenig Paul Thomas PR fortran/56789 * trans-expr.c (gfc_conv_procedure_call): Call gfc_conv_subref_array_arg if the formal arg is contiguous and the actual arg may not be. 2018-01-19 Thomas Koenig Paul Thomas PR fortran/56789 * gfortran.dg/contiguous_3.f90: Make code compilant. Remove scan-tree tests that fail with patch. * gfortran.dg/contiguous_8.f90: New test. Co-Authored-By: Paul Thomas From-SVN: r268096 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/trans-expr.c | 7 +++ gcc/testsuite/ChangeLog | 8 +++ gcc/testsuite/gfortran.dg/contiguous_3.f90 | 8 +-- gcc/testsuite/gfortran.dg/contiguous_8.f90 | 65 ++++++++++++++++++++++ 5 files changed, 90 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/contiguous_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 21e4c884f7c..c55cd7515f3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2018-01-19 Thomas Koenig + Paul Thomas + + PR fortran/56789 + * trans-expr.c (gfc_conv_procedure_call): Call + gfc_conv_subref_array_arg if the formal arg is contiguous + and the actual arg may not be. + 2019-01-17 Thomas Koenig PR fortran/88871 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b38d784bc0c..3238e7cb582 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5828,6 +5828,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, INTENT_IN, fsym && fsym->attr.pointer); } + else if (fsym && fsym->attr.contiguous + && !gfc_is_simply_contiguous (e, false, true)) + { + gfc_conv_subref_array_arg (&parmse, e, nodesc_arg, + fsym ? fsym->attr.intent : INTENT_INOUT, + fsym && fsym->attr.pointer); + } else gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2a59d1b0a4b..286614dff12 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-01-19 Thomas Koenig + Paul Thomas + + PR fortran/56789 + * gfortran.dg/contiguous_3.f90: Make code compilant. Remove + scan-tree tests that fail with patch. + * gfortran.dg/contiguous_8.f90: New test. + 2019-01-19 Richard Sandiford * gfortran.dg/loop_versioning_1.f90: Bump the number of identified diff --git a/gcc/testsuite/gfortran.dg/contiguous_3.f90 b/gcc/testsuite/gfortran.dg/contiguous_3.f90 index 0999f7b5b91..724ec83ed10 100644 --- a/gcc/testsuite/gfortran.dg/contiguous_3.f90 +++ b/gcc/testsuite/gfortran.dg/contiguous_3.f90 @@ -8,6 +8,8 @@ subroutine test1(a,b) integer, pointer, contiguous :: test1_a(:) + integer, target, dimension(3) :: aa + test1_a => aa call foo(test1_a) call foo(test1_a(::1)) call foo(test1_a(::2)) @@ -56,9 +58,3 @@ contains end subroutine bar end subroutine test3 -! Once for test1 (third call), once for test3 (second call) -! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } } - - diff --git a/gcc/testsuite/gfortran.dg/contiguous_8.f90 b/gcc/testsuite/gfortran.dg/contiguous_8.f90 new file mode 100644 index 00000000000..d362f1e381d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_8.f90 @@ -0,0 +1,65 @@ +! { dg-do run } +! PR 56789 - packing / unpacking of contiguous arguments +! did not happen. + +module my_module + implicit none +contains + subroutine cont_arg(a) + real, contiguous :: a(:,:) + integer :: i,j + do j=1,size(a,2) + do i=1,size(a,1) + a(i,j) = i+10*j + end do + end do + end subroutine cont_arg + subroutine cont_pointer_arg (a) + integer, pointer, contiguous :: a(:) + call assumed_size(a) + call assumed_size(a(::1)) + call assumed_size_2(a(::2)) + end subroutine cont_pointer_arg + + subroutine assumed_size(y) + integer, dimension(*) :: y + if (y(2) /= 2 .or. y(3) /= 3 .or. y(4) /= 4 .or. y(5) /= 5 .or. y(6) /= 6) & + stop 2 + end subroutine assumed_size + + subroutine assumed_size_2(y) + integer, dimension(*) :: y + if (y(1) /= 1 .or. y(2) /= 3 .or. y(3) /= 5) stop 3 + end subroutine assumed_size_2 + + subroutine cont_assumed_shape(x) + integer, dimension(:), contiguous :: x + if (size(x,1) == 8) then + if (any(x /= [1,2,3,4,5,6,7,8])) stop 4 + else + if (any(x /= [1,3,5,7])) stop 5 + end if + end subroutine cont_assumed_shape +end module my_module + +program main + use my_module + implicit none + real, dimension(5,5) :: a + real, dimension(5,5) :: res + integer, dimension(8), target :: t + integer, dimension(:), pointer, contiguous :: p + res = reshape([11., 1.,12., 1.,13.,& + 1., 1., 1., 1., 1.,& + 21., 1.,22., 1.,23.,& + 1., 1., 1., 1., 1.,& + 31., 1.,32., 1., 33.], shape(res)) + a = 1. + call cont_arg(a(1:5:2,1:5:2)) + if (any(a /= res)) stop 1 + t = [1,2,3,4,5,6,7,8] + p => t + call cont_pointer_arg(p) + call cont_assumed_shape (t) + call cont_assumed_shape (t(::2)) +end program main -- 2.30.2