re PR fortran/56789 (Handling of contiguous dummy arguments)
2018-01-19 Thomas Koenig <tkoenig@gcc.gnu.org> Paul Thomas <pault@gcc.gnu.org> 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 <tkoenig@gcc.gnu.org> Paul Thomas <pault@gcc.gnu.org> 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 <pault@gcc.gnu.org> From-SVN: r268096
This commit is contained in:
parent
e76c8e5612
commit
8558af5023
|
@ -1,3 +1,11 @@
|
|||
2018-01-19 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
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 <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/88871
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -1,3 +1,11 @@
|
|||
2018-01-19 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
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 <richard.sandiford@arm.com>
|
||||
|
||||
* gfortran.dg/loop_versioning_1.f90: Bump the number of identified
|
||||
|
|
|
@ -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" } }
|
||||
|
||||
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue