libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90

   1 ! { dg-do run }
   2
   3 ! { dg-additional-options -Wuninitialized }
   4
   5 module m
   6   implicit none
   7 contains
   8   pure subroutine add_ps_routine(a, b, c)
   9     implicit none
  10     !$acc routine seq
  11     integer, intent(in)  :: a, b
  12     integer, intent(out) :: c
  13     integer, parameter :: n = 10
  14     integer :: i
  15
  16     do i = 1, n
  17        if (i .eq. 5) then
  18           c = a + b
  19        end if
  20     end do
  21   end subroutine add_ps_routine
  22
  23   elemental impure function add_ef(a, b) result(c)
  24     implicit none
  25     !$acc routine
  26     integer, intent(in)  :: a, b
  27     integer :: c
  28
  29     call add_ps_routine(a, b, c)
  30   end function add_ef
  31   ! This '-Wmaybe-uninitialized' diagnostic appears for '-O2' only; PR102192.
  32   ! { dg-xfail-if PR102192 { *-*-* } { -O2 } }
  33   ! There's another instance (again '-O2' only) further down, but as any number
  34   ! of 'dg-xfail-if' only apply to the first 'dg-bogus' etc., we have no way to
  35   ! XFAIL that other one, so we instead match all of them here (via line '0'):
  36   ! { dg-bogus {'c' may be used uninitialized} {} { target *-*-* } 0 }
  37   ! { TODO_dg-bogus {'c' may be used uninitialized} {} { target *-*-* } .-7 }
  38 end module m
  39
  40 program main
  41   use m
  42   implicit none
  43   integer, parameter :: n = 10
  44   integer, dimension(n) :: a_a
  45   integer, dimension(n) :: b_a
  46   integer, dimension(n) :: c_a
  47   integer :: i
  48
  49   a_a = [(3 * i, i = 1, n)]
  50   b_a = [(-2 * i, i = 1, n)]
  51   !$acc parallel copyin(a_a, b_a) copyout(c_a)
  52   !$acc loop gang
  53   do i = 1, n
  54      if (i .eq. 4) then
  55         c_a = add_ef(a_a, b_a)
  56         ! See above.
  57         ! { TODO_dg-xfail-if PR102192 { *-*-* } { -O2 } }
  58         ! { TODO_dg-bogus {'c' may be used uninitialized} {} { target *-*-* } .-3 }
  59      end if
  60   end do
  61   !$acc end parallel
  62   if (any (c_a /= [(i, i=1, 10)])) stop 1
  63   !print *, a
  64 end program main