344f09a756
With the pr96628-part1.f90 source and -ftree-slp-vectorize, we run into an ICE due to the fact that V2DI mode is not handled in nvptx_gen_shuffle. Fix this by adding handling of V2DI as well as V2SI mode in nvptx_gen_shuffle. Build and reg-tested on x86_64 with nvptx accelerator. gcc/ChangeLog: PR target/96428 * config/nvptx/nvptx.c (nvptx_gen_shuffle): Handle V2SI/V2DI. libgomp/ChangeLog: PR target/96428 * testsuite/libgomp.oacc-fortran/pr96628-part1.f90: New test. * testsuite/libgomp.oacc-fortran/pr96628-part2.f90: New test.
21 lines
489 B
Fortran
21 lines
489 B
Fortran
! { dg-do run }
|
|
! { dg-additional-sources pr96628-part2.f90 }
|
|
! { dg-additional-options "-ftree-slp-vectorize" }
|
|
!
|
|
! This file is compiled first
|
|
module m2
|
|
real*8 :: mysum
|
|
!$acc declare device_resident(mysum)
|
|
contains
|
|
SUBROUTINE one(t)
|
|
!$acc routine
|
|
REAL*8, INTENT(IN) :: t(:)
|
|
mysum = sum(t)
|
|
END SUBROUTINE one
|
|
SUBROUTINE two(t)
|
|
!$acc routine seq
|
|
REAL*8, INTENT(INOUT) :: t(:)
|
|
t = (100.0_8*t)/sum
|
|
END SUBROUTINE two
|
|
end module m2
|