gcc/testsuite/gfortran.dg/findloc_5.f90

   1 ! { dg-do  run }
   2 ! Check compile-time simplification of FINDLOC
   3 program main
   4   integer,  dimension(4),  parameter :: a1 = [1,  2,  3,  1]
   5   integer,  parameter :: i1 = findloc(a1, 1, dim=1)
   6   integer,  parameter :: i2 = findloc(a1, 2, dim=1)
   7   integer,  parameter :: i3 = findloc(a1, 3, dim=1)
   8   integer,  parameter :: i4 = findloc(a1, 1, dim=1, back=.true.)
   9   integer,  parameter :: i0 = findloc(a1, -1, dim=1)
  10   logical,  dimension(4),  parameter :: msk = [.false., .true., .true., .true.]
  11   integer,  parameter :: i4a = findloc(a1, 1, dim=1, mask=msk)
  12   integer,  parameter :: i4b = findloc(a1, 1, dim=1, mask=msk, back=.true.)
  13   real, dimension(2,2), parameter :: a = reshape([1.,2.,3.,4.], [2,2]), &
  14        b =  reshape([1.,2.,1.,2.], [2,2])
  15   integer, parameter, dimension(2) :: t8 = findloc(a, 5.), t9 = findloc(a, 5., back=.true.)
  16   integer, parameter, dimension(2) :: t10= findloc(a, 2.), t11= findloc(a, 2., back=.true.)
  17   logical, dimension(2,2), parameter :: lo = reshape([.true., .false., .true., .true. ], [2,2])
  18   integer, parameter, dimension(2) :: t12 = findloc(b,2., mask=lo)
  19
  20   integer, dimension(2,3), parameter :: c = reshape([1,2,2,2,-9,6], [2,3])
  21   integer, parameter, dimension(3) :: t13 = findloc(c, value=2, dim=1)
  22   integer, parameter, dimension(2) :: t14 = findloc(c, value=2, dim=2)
  23
  24   character(len=2), dimension(3,3), parameter :: ac = reshape ( &
  25        ["11", "21", "31", "12", "22", "32", "13", "23", "33"], [3,3]);
  26   character(len=3), dimension(3,3), parameter :: bc = reshape (&
  27        ["11 ", "21 ", "31 ", "12 ", "22 ", "32 ", "13 ", "23 ", "33 "], [3,3]);
  28   integer, parameter, dimension(2) :: t15 = findloc(ac, "11")
  29   integer, parameter, dimension(2) :: t16 = findloc(bc, "31")
  30
  31   if (i1 /= 1) stop 1
  32   if (i2 /= 2) stop 2
  33   if (i3 /= 3) stop 3
  34   if (i4 /= 4) stop 4
  35   if (i0 /= 0) stop 5
  36   if (i4a /= 4) stop 6
  37   if (i4b /= 4) stop 7
  38   if (any(t8 /= [0,0])) stop 8
  39   if (any(t9 /= [0,0])) stop 9
  40   if (any(t10 /= [2,1])) stop 10
  41   if (any(t11 /= [2,1])) stop 11
  42   if (any(t12 /= [2,2])) stop 12
  43   if (any(t13 /= [2,1,0])) stop 13
  44   if (any(t14 /= [2,1])) stop 14
  45   if (any(t15 /= [1,1])) stop 15
  46   if (any(t16 /= [3,1])) stop 16
  47 end program main