From 4b53b3475fc6c1641362d9b591a3e91c20d6a22d Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 1 Nov 2018 20:12:57 +0000 Subject: [PATCH] re PR fortran/54613 ([F08] Add FINDLOC plus support MAXLOC/MINLOC with KIND=/BACK=) 2017-11-01 Thomas Koenig PR fortran/54613 * gfortran.dg/findloc_1.f90: Actually commit. * gfortran.dg/findloc_2.f90: Actually commit. * gfortran.dg/findloc_3.f90: Actually commit. * gfortran.dg/findloc_4.f90: Actually commit. * gfortran.dg/findloc_5.f90: Actually commit. * gfortran.dg/findloc_6.f90: Actually commit. From-SVN: r265732 --- gcc/testsuite/ChangeLog | 10 ++++ gcc/testsuite/gfortran.dg/findloc_1.f90 | 13 +++++ gcc/testsuite/gfortran.dg/findloc_2.f90 | 31 ++++++++++ gcc/testsuite/gfortran.dg/findloc_3.f90 | 77 +++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/findloc_4.f90 | 25 ++++++++ gcc/testsuite/gfortran.dg/findloc_5.f90 | 47 +++++++++++++++ gcc/testsuite/gfortran.dg/findloc_6.f90 | 53 +++++++++++++++++ gcc/testsuite/gfortran.dg/findloc_7.f90 | 9 +++ 8 files changed, 265 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/findloc_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/findloc_7.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4f1076169a1..f206f8b3878 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2017-11-01 Thomas Koenig + + PR fortran/54613 + * gfortran.dg/findloc_1.f90: Actually commit. + * gfortran.dg/findloc_2.f90: Actually commit. + * gfortran.dg/findloc_3.f90: Actually commit. + * gfortran.dg/findloc_4.f90: Actually commit. + * gfortran.dg/findloc_5.f90: Actually commit. + * gfortran.dg/findloc_6.f90: Actually commit. + 2018-11-01 Paul Thomas PR fortran/40196 diff --git a/gcc/testsuite/gfortran.dg/findloc_1.f90 b/gcc/testsuite/gfortran.dg/findloc_1.f90 new file mode 100644 index 00000000000..220b8ad71bf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_1.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! Test errors in findloc. +program main + integer, dimension(4) :: a + logical, dimension(3) :: msk + a = [2,4,6,8] + print *,findloc(a) ! { dg-error "Missing actual argument" } + print *,findloc(a,value=.true.) ! { dg-error "must be in type conformance to argument" } + print *,findloc(a,23,dim=6) ! { dg-error "is not a valid dimension index" } + print *,findloc(a,-42,dim=2.0) ! { dg-error "must be INTEGER" } + print *,findloc(a,6,msk) ! { dg-error "Different shape for arguments 'array' and 'mask'" } + print *,findloc(a,6,kind=98) ! { dg-error "Invalid kind for INTEGER" } +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_2.f90 b/gcc/testsuite/gfortran.dg/findloc_2.f90 new file mode 100644 index 00000000000..7ebc63abb86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_2.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! Various tests with findloc. +program main + implicit none + real, dimension(2,2) :: a, b + integer, dimension(2,3) :: c + logical, dimension(2,2) :: lo + integer, dimension(:), allocatable :: e + a = reshape([1.,2.,3.,4.], shape(a)) + b = reshape([1.,2.,1.,2.], shape(b)) + + lo = .true. + + if (any(findloc(a, 5.) /= [0,0])) stop 1 + if (any(findloc(a, 5., back=.true.) /= [0,0])) stop 2 + if (any(findloc(a, 2.) /= [2,1])) stop 2 + if (any(findloc(a, 2. ,back=.true.) /= [2,1])) stop 3 + + if (any(findloc(a,3.,mask=lo) /= [1,2])) stop 4 + if (any(findloc(a,3,mask=.true.) /= [1,2])) stop 5 + lo(1,2) = .false. + if (any(findloc(a,3.,mask=lo) /= [0,0])) stop 6 + if (any(findloc(b,2.) /= [2,1])) stop 7 + if (any(findloc(b,2.,back=.true.) /= [2,2])) stop 8 + if (any(findloc(b,1.,mask=lo,back=.true.) /= [1,1])) stop 9 + if (any(findloc(b,1.,mask=.false.) /= [0,0])) stop 10 + + c = reshape([1,2,2,2,-9,6], shape(c)) + if (any(findloc(c,value=2,dim=1) /= [2,1,0])) stop 11 + if (any(findloc(c,value=2,dim=2) /= [2,1])) stop 12 +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_3.f90 b/gcc/testsuite/gfortran.dg/findloc_3.f90 new file mode 100644 index 00000000000..f83c122946e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_3.f90 @@ -0,0 +1,77 @@ +! { dg-do run } +! Various tests with findloc with character variables. +program main + character(len=2) :: a(3,3), c(3,3), d(3,4) + character(len=3) :: b(3,3) + integer :: ret(2) + integer :: i,j + character(len=3) :: s + logical :: lo + logical, dimension(3,4) :: msk + data a /"11", "21", "31", "12", "22", "32", "13", "23", "33" / + data b /"11 ", "21 ", "31 ", "12 ", "22 ", "32 ", "13 ", "23 ", "33 " / + if (any(findloc(a,"11 ") /= [1,1])) stop 1 + ret = findloc(b,"31") + do j=1,3 + do i=1,3 + write(unit=s,fmt='(2I1," ")') i,j + ret = findloc(b,s) + if (b(ret(1),ret(2)) /= s) stop 2 + end do + end do + + if (any(findloc(b(::2,::2),"13") /= [1,2])) stop 3 + + do j=1,3 + do i=1,3 + write(unit=c(i,j),fmt='(I2)') 2+i-j + end do + end do + + if (any(findloc(c," 1") /= [1,2])) stop 4 + if (any(findloc(c," 1", back=.true.) /= [2,3])) stop 5 + if (any(findloc(c," 1", back=.true., mask=.false.) /= [0,0])) stop 6 + + lo = .true. + if (any(findloc(c," 2", dim=1) /= [1,2,3])) stop 7 + if (any(findloc(c," 2",dim=1,mask=lo) /= [1,2,3])) stop 8 + + if (any(findloc(c," 2", dim=1,back=.true.) /= [1,2,3])) stop 9 + if (any(findloc(c," 2",dim=1,mask=lo,back=.true.) /= [1,2,3])) stop 10 + do j=1,4 + do i=1,3 + if (j<= i) then + d(i,j) = "AA" + else + d(i,j) = "BB" + end if + end do + end do + print '(4A3)', transpose(d) + if (any(findloc(d,"AA") /= [1,1])) stop 11 + if (any(findloc(d,"BB") /= [1,2])) stop 12 + msk = .true. + if (any(findloc(d,"AA", mask=msk) /= [1,1])) stop 11 + if (any(findloc(d,"BB", mask=msk) /= [1,2])) stop 12 + if (any(findloc(d,"AA", dim=1) /= [1,2,3,0])) stop 13 + if (any(findloc(d,"BB", dim=1) /= [0,1,1,1])) stop 14 + if (any(findloc(d,"AA", dim=2) /= [1,1,1])) stop 15 + if (any(findloc(d,"BB", dim=2) /= [2,3,4])) stop 16 + if (any(findloc(d,"AA", dim=1,mask=msk) /= [1,2,3,0])) stop 17 + if (any(findloc(d,"BB", dim=1,mask=msk) /= [0,1,1,1])) stop 18 + if (any(findloc(d,"AA", dim=2,mask=msk) /= [1,1,1])) stop 19 + if (any(findloc(d,"BB", dim=2,mask=msk) /= [2,3,4])) stop 20 + + if (any(findloc(d,"AA", dim=1, back=.true.) /= [3,3,3,0])) stop 21 + if (any(findloc(d,"AA", dim=1, back=.true., mask=msk) /= [3,3,3,0])) stop 22 + if (any(findloc(d,"BB", dim=2, back=.true.) /= [4,4,4])) stop 23 + if (any(findloc(d,"BB", dim=2, back=.true.,mask=msk) /= [4,4,4])) stop 24 + + msk(1,:) = .false. + print '(4L3)', transpose(msk) + if (any(findloc(d,"AA", dim=1,mask=msk) /= [2,2,3,0])) stop 21 + if (any(findloc(d,"BB", dim=2,mask=msk) /= [0,3,4])) stop 22 + if (any(findloc(d,"AA", dim=2, mask=msk, back=.true.) /= [0,2,3])) stop 23 + if (any(findloc(d,"AA", dim=1, mask=msk, back=.true.) /= [3,3,3,0])) stop 24 + +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_4.f90 b/gcc/testsuite/gfortran.dg/findloc_4.f90 new file mode 100644 index 00000000000..f31977b753c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_4.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! Test findloc with dim argument. + +program main + implicit none + real, dimension(2,2) :: a, b + logical, dimension(2,2) :: lo + a = reshape([1.,2.,3.,4.], shape(a)) + b = reshape([1.,1.,1.,1.], shape(b)) + + lo = .true. + + if (any(findloc(b,value=1.,dim=1) /= [1,1])) stop 1 + if (any(findloc(b,value=1.,dim=2) /= [1,1])) stop 2 + if (any(findloc(b,value=1.,dim=1,back=.true.) /= [2,2])) stop 3 + if (any(findloc(b,value=1.,dim=2,back=.true.) /= [2,2])) stop 4 + if (any(findloc(b,value=1.,dim=1,mask=lo) /= [1,1])) stop 5 + + if (any(findloc(b,value=1.,dim=1,mask=lo,back=.true.) /= [2,2])) stop 6 + if (any(findloc(b,value=1.,dim=1,mask=.not. lo) /= [0,0])) stop 7 + lo(1,1) = .false. + if (any(findloc(b,value=1.,dim=1,mask=lo) /= [2,1])) stop 8 + if (any(findloc(a,value=1.5,dim=2,back=.true.) /= [0,0])) stop 9 + if (any(findloc(a,value=1,dim=1,mask=lo) /= [0,0])) stop 10 +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_5.f90 b/gcc/testsuite/gfortran.dg/findloc_5.f90 new file mode 100644 index 00000000000..cf4bd3e2125 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_5.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! Check compile-time simplification of FINDLOC +program main + integer, dimension(4), parameter :: a1 = [1, 2, 3, 1] + integer, parameter :: i1 = findloc(a1, 1, dim=1) + integer, parameter :: i2 = findloc(a1, 2, dim=1) + integer, parameter :: i3 = findloc(a1, 3, dim=1) + integer, parameter :: i4 = findloc(a1, 1, dim=1, back=.true.) + integer, parameter :: i0 = findloc(a1, -1, dim=1) + logical, dimension(4), parameter :: msk = [.false., .true., .true., .true.] + integer, parameter :: i4a = findloc(a1, 1, dim=1, mask=msk) + integer, parameter :: i4b = findloc(a1, 1, dim=1, mask=msk, back=.true.) + real, dimension(2,2), parameter :: a = reshape([1.,2.,3.,4.], [2,2]), & + b = reshape([1.,2.,1.,2.], [2,2]) + integer, parameter, dimension(2) :: t8 = findloc(a, 5.), t9 = findloc(a, 5., back=.true.) + integer, parameter, dimension(2) :: t10= findloc(a, 2.), t11= findloc(a, 2., back=.true.) + logical, dimension(2,2), parameter :: lo = reshape([.true., .false., .true., .true. ], [2,2]) + integer, parameter, dimension(2) :: t12 = findloc(b,2., mask=lo) + + integer, dimension(2,3), parameter :: c = reshape([1,2,2,2,-9,6], [2,3]) + integer, parameter, dimension(3) :: t13 = findloc(c, value=2, dim=1) + integer, parameter, dimension(2) :: t14 = findloc(c, value=2, dim=2) + + character(len=2), dimension(3,3), parameter :: ac = reshape ( & + ["11", "21", "31", "12", "22", "32", "13", "23", "33"], [3,3]); + character(len=3), dimension(3,3), parameter :: bc = reshape (& + ["11 ", "21 ", "31 ", "12 ", "22 ", "32 ", "13 ", "23 ", "33 "], [3,3]); + integer, parameter, dimension(2) :: t15 = findloc(ac, "11") + integer, parameter, dimension(2) :: t16 = findloc(bc, "31") + + if (i1 /= 1) stop 1 + if (i2 /= 2) stop 2 + if (i3 /= 3) stop 3 + if (i4 /= 4) stop 4 + if (i0 /= 0) stop 5 + if (i4a /= 4) stop 6 + if (i4b /= 4) stop 7 + if (any(t8 /= [0,0])) stop 8 + if (any(t9 /= [0,0])) stop 9 + if (any(t10 /= [2,1])) stop 10 + if (any(t11 /= [2,1])) stop 11 + if (any(t12 /= [2,2])) stop 12 + if (any(t13 /= [2,1,0])) stop 13 + if (any(t14 /= [2,1])) stop 14 + if (any(t15 /= [1,1])) stop 15 + if (any(t16 /= [3,1])) stop 16 +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_6.f90 b/gcc/testsuite/gfortran.dg/findloc_6.f90 new file mode 100644 index 00000000000..6fa72d84c65 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_6.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! Test different code paths for findloc with scalar result. + +program main + integer, dimension(0:5) :: a = [1,2,3,1,2,3] + logical, dimension(6) :: mask = [.false.,.false.,.false.,.true.,.true.,.true.] + logical, dimension(6) :: mask2 + logical :: true, false + character(len=2), dimension(6) :: ch = ["AA", "BB", "CC", "AA", "BB", "CC"] + + true = .true. + false = .false. + mask2 = .not. mask + +! Tests without mask + + if (findloc(a,2,dim=1,back=false) /= 2) stop 1 + if (findloc(a,2,dim=1,back=.false.) /= 2) stop 2 + if (findloc(a,2,dim=1) /= 2) stop 3 + if (findloc(a,2,dim=1,back=.true.) /= 5) stop 4 + if (findloc(a,2,dim=1,back=true) /= 5) stop 5 + +! Test with array mask + if (findloc(a,2,dim=1,mask=mask) /= 5) stop 6 + if (findloc(a,2,dim=1,mask=mask,back=.true.) /= 5) stop 7 + if (findloc(a,2,dim=1,mask=mask,back=.false.) /= 5) stop 8 + if (findloc(a,2,dim=1,mask=mask2) /= 2) stop 9 + if (findloc(a,2,dim=1,mask=mask2,back=.true.) /= 2) stop 10 + if (findloc(a,2,dim=1,mask=mask2,back=true) /= 2) stop 11 + +! Test with scalar mask + + if (findloc(a,2,dim=1,mask=.true.) /= 2) stop 12 + if (findloc(a,2,dim=1,mask=.false.) /= 0) stop 13 + if (findloc(a,2,dim=1,mask=true) /= 2) stop 14 + if (findloc(a,2,dim=1,mask=false) /= 0) stop 15 + +! Some character tests + + if (findloc(ch,"AA",dim=1) /= 1) stop 16 + if (findloc(ch,"AA",dim=1,mask=mask) /= 4) stop 17 + if (findloc(ch,"AA",dim=1,back=.true.) /= 4) stop 18 + if (findloc(ch,"AA",dim=1,mask=mask2,back=.true.) /= 1) stop 19 + +! Nothing to be found here... + if (findloc(ch,"DD",dim=1) /= 0) stop 20 + if (findloc(a,4,dim=1) /= 0) stop 21 + +! Finally, character tests with a scalar mask. + + if (findloc(ch,"CC ",dim=1,mask=true) /= 3) stop 22 + if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23 +end program main diff --git a/gcc/testsuite/gfortran.dg/findloc_7.f90 b/gcc/testsuite/gfortran.dg/findloc_7.f90 new file mode 100644 index 00000000000..9dd9aa3e8a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_7.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! This used to ICE with an infinite recursion during development. +! Test case by Dominique d'Humieres. + +program logtest3 + implicit none + logical :: x = .true. + integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, back=x) ! { dg-error "does not reduce to a constant expression" } +end program logtest3 -- 2.30.2