* Re: [patch, fortran] Implement FINDLOC
@ 2018-10-22 1:11 Dominique d'Humières
2018-10-22 22:15 ` Thomas Koenig
0 siblings, 1 reply; 8+ messages in thread
From: Dominique d'Humières @ 2018-10-22 1:11 UTC (permalink / raw)
To: Thomas Koenig; +Cc: gfortran, gcc-patches
Hi Thomas,
With your patch, compiling the following test
program logtest3
implicit none
logical :: x = .true.
integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
back=x)
end program logtest3
gives an ICE
gfc: internal compiler error: Segmentation fault: 11 signal terminated program f951
I see some kind of "infinite" recursion
…
frame #899971: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bd80) at expr.c:2374
frame #899972: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bd80)
frame #899973: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bd80)
frame #899974: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bc40) at expr.c:2374
frame #899975: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bc40)
frame #899976: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bc40)
frame #899977: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bb00) at expr.c:2374
frame #899978: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bb00)
frame #899979: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bb00)
frame #899980: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34b9c0) at expr.c:2374
frame #899981: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34b9c0)
frame #899982: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34b9c0)
Also in gfortran.dg/findloc_4.f90 should not the lines
print *,findloc(a,value=1.5,dim=2,back=.true.)
print *,findloc(a,value=1,dim=1,mask=lo)
converted to tests?
Thanks for working on the implementation of FINDLOC.
Dominique
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-22 1:11 [patch, fortran] Implement FINDLOC Dominique d'Humières
@ 2018-10-22 22:15 ` Thomas Koenig
2018-10-23 8:19 ` Bernhard Reutner-Fischer
2018-10-23 16:37 ` Dominique d'Humières
0 siblings, 2 replies; 8+ messages in thread
From: Thomas Koenig @ 2018-10-22 22:15 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 559 bytes --]
Hi Dominique,
> With your patch, compiling the following test
>
> program logtest3
> implicit none
> logical :: x = .true.
> integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
> back=x)
> end program logtest3
>
> gives an ICE
I sometimes wonder where you get all these test cases from...
Anyway, the attached patch fixes this, plus the print *, instead
of test for return values, plus the whitespace issues mentioned
by Bernhard. Patch gzipped this time to let it go through to
gcc-patches.
OK for trunk?
Regards
Thomas
[-- Attachment #2: p15.diff.gz --]
[-- Type: application/gzip, Size: 19931 bytes --]
[-- Attachment #3: findloc_1.f90 --]
[-- Type: text/x-fortran, Size: 615 bytes --]
! { 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
[-- Attachment #4: findloc_2.f90 --]
[-- Type: text/x-fortran, Size: 1059 bytes --]
! { 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
[-- Attachment #5: findloc_3.f90 --]
[-- Type: text/x-fortran, Size: 2731 bytes --]
! { 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
[-- Attachment #6: findloc_4.f90 --]
[-- Type: text/x-fortran, Size: 912 bytes --]
! { 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
[-- Attachment #7: findloc_5.f90 --]
[-- Type: text/x-fortran, Size: 2188 bytes --]
! { 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
[-- Attachment #8: findloc_6.f90 --]
[-- Type: text/x-fortran, Size: 1791 bytes --]
! { 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 22
end program main
[-- Attachment #9: findloc_7.f90 --]
[-- Type: text/x-fortran, Size: 311 bytes --]
! { 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 "is not permitted" }
end program logtest3
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-22 22:15 ` Thomas Koenig
@ 2018-10-23 8:19 ` Bernhard Reutner-Fischer
2018-10-23 16:37 ` Dominique d'Humières
1 sibling, 0 replies; 8+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-10-23 8:19 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Dominique d'Humières, gfortran, GCC Patches
On Mon, 22 Oct 2018 at 23:01, Thomas Koenig <tkoenig@netcologne.de> wrote:
> Anyway, the attached patch fixes this, plus the print *, instead
> of test for return values, plus the whitespace issues mentioned
> by Bernhard. Patch gzipped this time to let it go through to
> gcc-patches.
Thanks, The few remainin issues are:
$ ./contrib/check_GNU_style.py /tmp/p15.diff
=== ERROR type #1: blocks of 8 spaces should be replaced with tabs (1
error(s)) ===
gcc/fortran/simplify.c:5667:17: dim_index -= 1;████████ /*
zero-base index */
=== ERROR type #2: dot, space, space, end of comment (1 error(s)) ===
gcc/fortran/simplify.c:5667:50: dim_index -= 1; /*
zero-base index */
=== ERROR type #3: dot, space, space, new sentence (3 error(s)) ===
gcc/fortran/check.c:3363:30:/* Check function for findloc.█Mostly like
gfc_check_minloc_maxloc
gcc/fortran/simplify.c:5604:32:/* Simplify findloc to an array.█Similar to
gcc/fortran/simplify.c:5627:27: linked-list traversal.█Masked
elements are set to NULL. */
=== ERROR type #4: lines should not exceed 80 characters (196 error(s)) ===
gcc/fortran/check.c:159:80: gfc_error ("%qs argument of %qs
intrinsic at %L must be of intrinsic type",
gcc/fortran/intrinsic.c:728:80:add_sym_6fl (const char *name,
gfc_isym_id id, enum klass cl, int actual_ok, bt type,
gcc/fortran/simplify.c:5674:80: tmpstride[i] = (i == 0) ? 1 :
tmpstride[i-1] * mpz_get_si (array->shape[i-1]);
=== ERROR type #6: trailing operator (1 error(s)) ===
gcc/fortran/iresolve.c:1873:25: f->value.function.name =
(this wants ...function.name\n = gfc_get_string (... )
=== ERROR type #7: trailing whitespace (2 error(s)) ===
gcc/fortran/check.c:3390:0:███
gcc/fortran/simplify.c:5794:10: else█
TIA,
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-22 22:15 ` Thomas Koenig
2018-10-23 8:19 ` Bernhard Reutner-Fischer
@ 2018-10-23 16:37 ` Dominique d'Humières
2018-10-23 21:47 ` Thomas Koenig
1 sibling, 1 reply; 8+ messages in thread
From: Dominique d'Humières @ 2018-10-23 16:37 UTC (permalink / raw)
To: Thomas Koenig; +Cc: gfortran, gcc-patches
> Le 22 oct. 2018 à 23:00, Thomas Koenig <tkoenig@netcologne.de> a écrit :
>
> Hi Dominique,
>
>> With your patch, compiling the following test
>> program logtest3
>> implicit none
>> logical :: x = .true.
>> integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
>> back=x)
>> end program logtest3
>> gives an ICE
>
> I sometimes wonder where you get all these test cases from…
This is a reduction of a James van Buskirk's test at
https://groups.google.com/forum/?fromgroups=#!topic/comp.lang.fortran/GpaACNKn0Ds
>
> Anyway, the attached patch fixes this,
It now gives the error
4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
| 1
Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression
However a similar test
program logtest3
implicit none
integer, parameter :: A1 = 2
logical, parameter :: L1 = transfer(A1,.FALSE.)
integer, parameter :: I_FINDLOC_MASK(1) = findloc([1,1],1, &
mask=[L1,.TRUE.])
print *, A1, L1, I_FINDLOC_MASK(1)
end program logtest3
compiles and gives ' 2 F 2’ at run time. Also I see several transformational intrinsic accepted as initialization expressions.
The following test
program logtest3
implicit none
! ********************************************************!
! ******* Everything depends on this parameter ***********!
integer, parameter :: A1 = 2
logical :: L
L = transfer(A1,L)
call sub(L)
end program logtest3
subroutine sub(x)
implicit none
logical x
integer a(1)
character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']
a = findloc([1,1],1,mask=[x,.TRUE.])
write(*,'(a)') 'Value by FINDLOC(MASK): '// &
trim(strings(a(1)))
a = findloc([1,1],1,back=x)
write(*,'(a)') 'Value by FINDLOC(BACK): '// &
trim(strings(3-a(1)))
end subroutine sub
does not link:
8 | L = transfer(A1,L)
| 1
Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
Undefined symbols for architecture x86_64:
"__gfortran_findloc0_i4", referenced from:
_sub_ in ccnoLKfH.o
"__gfortran_mfindloc0_i4", referenced from:
_sub_ in ccnoLKfH.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status
Finally the line before the end of findloc_6.f90 should be
if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23
TIA
Dominique
> plus the print *, instead
> of test for return values, plus the whitespace issues mentioned
> by Bernhard. Patch gzipped this time to let it go through to
> gcc-patches.
>
> OK for trunk?
>
> Regards
>
> Thomas
>
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-23 16:37 ` Dominique d'Humières
@ 2018-10-23 21:47 ` Thomas Koenig
2018-10-27 18:44 ` Thomas Koenig
2018-10-28 17:32 ` Paul Richard Thomas
0 siblings, 2 replies; 8+ messages in thread
From: Thomas Koenig @ 2018-10-23 21:47 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2092 bytes --]
Am 23.10.18 um 18:16 schrieb Dominique d'Humières:
>
>> Anyway, the attached patch fixes this,
>
> It now gives the error
>
> 4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
> | 1
> Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression
That error message was misleading, the new one now has
Error: Parameter 'x' at (1) has not been declared or is a variable,
which does not reduce to a constant expression
> The following test
>
> program logtest3
> implicit none
> ! ********************************************************!
> ! ******* Everything depends on this parameter ***********!
>
> integer, parameter :: A1 = 2
> logical :: L
> L = transfer(A1,L)
> call sub(L)
> end program logtest3
>
> subroutine sub(x)
> implicit none
> logical x
> integer a(1)
> character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']
>
> a = findloc([1,1],1,mask=[x,.TRUE.])
> write(*,'(a)') 'Value by FINDLOC(MASK): '// &
> trim(strings(a(1)))
> a = findloc([1,1],1,back=x)
> write(*,'(a)') 'Value by FINDLOC(BACK): '// &
> trim(strings(3-a(1)))
>
> end subroutine sub
>
> does not link:
>
> 8 | L = transfer(A1,L)
> | 1
> Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
> Undefined symbols for architecture x86_64:
> "__gfortran_findloc0_i4", referenced from:
> _sub_ in ccnoLKfH.o
> "__gfortran_mfindloc0_i4", referenced from:
> _sub_ in ccnoLKfH.o
> ld: symbol(s) not found for architecture x86_64
> collect2: error: ld returned 1 exit status
Ah, I didn't include the newly generated files in the previous patch.
Now included.
> Finally the line before the end of findloc_6.f90 should be
>
> if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23
Changed, also the whitespace fixes that Bernhard mentioned.
So, I think this should be clear for trunk now. I will supply
the documentation later.
Regards
Thomas
[-- Attachment #2: findloc_1.f90 --]
[-- Type: text/x-fortran, Size: 615 bytes --]
! { 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
[-- Attachment #3: findloc_2.f90 --]
[-- Type: text/x-fortran, Size: 1059 bytes --]
! { 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
[-- Attachment #4: findloc_3.f90 --]
[-- Type: text/x-fortran, Size: 2731 bytes --]
! { 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
[-- Attachment #5: findloc_4.f90 --]
[-- Type: text/x-fortran, Size: 912 bytes --]
! { 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
[-- Attachment #6: findloc_5.f90 --]
[-- Type: text/x-fortran, Size: 2188 bytes --]
! { 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
[-- Attachment #7: findloc_6.f90 --]
[-- Type: text/x-fortran, Size: 1791 bytes --]
! { 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
[-- Attachment #8: findloc_7.f90 --]
[-- Type: text/x-fortran, Size: 335 bytes --]
! { 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
[-- Attachment #9: p15b.diff.gz --]
[-- Type: application/gzip, Size: 31672 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-23 21:47 ` Thomas Koenig
@ 2018-10-27 18:44 ` Thomas Koenig
2018-10-28 17:32 ` Paul Richard Thomas
1 sibling, 0 replies; 8+ messages in thread
From: Thomas Koenig @ 2018-10-27 18:44 UTC (permalink / raw)
To: fortran, gcc-patches
Am 23.10.18 um 23:02 schrieb Thomas Koenig:
> So, I think this should be clear for trunk now. I will supply
> the documentation later.
Ping ** 0.571428 ?
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-23 21:47 ` Thomas Koenig
2018-10-27 18:44 ` Thomas Koenig
@ 2018-10-28 17:32 ` Paul Richard Thomas
2018-10-28 19:57 ` Thomas Koenig
1 sibling, 1 reply; 8+ messages in thread
From: Paul Richard Thomas @ 2018-10-28 17:32 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches
Hi Thomas,
The patch is ready to go. Please correct the following tiny nits:
s/Check that en expression/Check that an expression/
s/Set this if resolution has already happened and it could be
harmful/Set this if resolution has already happened. It could be
harmful/
An even tinier, probably ignorable one: Why did you break this line?
-/* MINLOC and MAXLOC get special treatment because their argument
- might have to be reordered. */
Many thanks for working on this.
Cheers
Paul
On Tue, 23 Oct 2018 at 22:03, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Am 23.10.18 um 18:16 schrieb Dominique d'Humières:
> >
>
> >> Anyway, the attached patch fixes this,
> >
> > It now gives the error
> >
> > 4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
> > | 1
> > Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression
>
> That error message was misleading, the new one now has
>
> Error: Parameter 'x' at (1) has not been declared or is a variable,
> which does not reduce to a constant expression
>
> > The following test
> >
> > program logtest3
> > implicit none
> > ! ********************************************************!
> > ! ******* Everything depends on this parameter ***********!
> >
> > integer, parameter :: A1 = 2
> > logical :: L
> > L = transfer(A1,L)
> > call sub(L)
> > end program logtest3
> >
> > subroutine sub(x)
> > implicit none
> > logical x
> > integer a(1)
> > character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']
> >
> > a = findloc([1,1],1,mask=[x,.TRUE.])
> > write(*,'(a)') 'Value by FINDLOC(MASK): '// &
> > trim(strings(a(1)))
> > a = findloc([1,1],1,back=x)
> > write(*,'(a)') 'Value by FINDLOC(BACK): '// &
> > trim(strings(3-a(1)))
> >
> > end subroutine sub
> >
> > does not link:
> >
> > 8 | L = transfer(A1,L)
> > | 1
> > Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
> > Undefined symbols for architecture x86_64:
> > "__gfortran_findloc0_i4", referenced from:
> > _sub_ in ccnoLKfH.o
> > "__gfortran_mfindloc0_i4", referenced from:
> > _sub_ in ccnoLKfH.o
> > ld: symbol(s) not found for architecture x86_64
> > collect2: error: ld returned 1 exit status
>
> Ah, I didn't include the newly generated files in the previous patch.
> Now included.
>
>
> > Finally the line before the end of findloc_6.f90 should be
> >
> > if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23
>
> Changed, also the whitespace fixes that Bernhard mentioned.
>
> So, I think this should be clear for trunk now. I will supply
> the documentation later.
>
> Regards
>
> Thomas
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, fortran] Implement FINDLOC
2018-10-28 17:32 ` Paul Richard Thomas
@ 2018-10-28 19:57 ` Thomas Koenig
0 siblings, 0 replies; 8+ messages in thread
From: Thomas Koenig @ 2018-10-28 19:57 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: fortran, gcc-patches
Hi Paul,
> The patch is ready to go. Please correct the following tiny nits:
I have corrected those.
> s/Check that en expression/Check that an expression/
>
> s/Set this if resolution has already happened and it could be
> harmful/Set this if resolution has already happened. It could be
> harmful/
> An even tinier, probably ignorable one: Why did you break this line?
> -/* MINLOC and MAXLOC get special treatment because their argument
> - might have to be reordered. */
I think I hit M-q in emacs at some stage - I have left it as it is.
Thanks for the review!
Committed as r265570.
Regards
Thomas
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2018-10-28 12:21 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-10-22 1:11 [patch, fortran] Implement FINDLOC Dominique d'Humières
2018-10-22 22:15 ` Thomas Koenig
2018-10-23 8:19 ` Bernhard Reutner-Fischer
2018-10-23 16:37 ` Dominique d'Humières
2018-10-23 21:47 ` Thomas Koenig
2018-10-27 18:44 ` Thomas Koenig
2018-10-28 17:32 ` Paul Richard Thomas
2018-10-28 19:57 ` Thomas Koenig
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).