Hello world, the attached patch implements maxloc and minloc, a missing feature / bug (now that we are shooting for f2003 compliance). I decided to do everything on the library side, since I am more familiar with that territory. I also suspect that any performance gain from inlining will be less pronounced than with intrinsic types.
There is one question regarding the ABI. Apparently, the string length
is passed as an int even on a 64-bit system. I verified that this
is indeed the case by doing the actual work on a
powerpc64-unknown-linux-gnu box (gcc110 on the gcc compile farm),
which is big-endian. If we were actually passing an eight-byte
quantity, and only getting the upper bytes, we would crash & burn.
Now, I _thought_ we were passing string lengths as size_t now (Janne?),
but maybe something was missing in that change.
So, this works, and passes regression testing. OK for trunk?
If so, I would tackle maxval next, in a similar fashion.
If anybody has another resolution for the size_t vs. int issue - the
nice thing about m4 is that it is fairly easy to make that change.
Regards
Thomas
2017-11-19 Thomas Koenig <[email protected]>
PR fortran/36313
* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
* Makefile.in: Regenerated.
* generated/maxloc0_16_s1.c: New file.
* generated/maxloc0_16_s4.c: New file.
* generated/maxloc0_4_s1.c: New file.
* generated/maxloc0_4_s4.c: New file.
* generated/maxloc0_8_s1.c: New file.
* generated/maxloc0_8_s4.c: New file.
* generated/maxloc1_16_s1.c: New file.
* generated/maxloc1_16_s4.c: New file.
* generated/maxloc1_4_s1.c: New file.
* generated/maxloc1_4_s4.c: New file.
* generated/maxloc1_8_s1.c: New file.
* generated/maxloc1_8_s4.c: New file.
* generated/maxloc2_16_s1.c: New file.
* generated/maxloc2_16_s4.c: New file.
* generated/maxloc2_4_s1.c: New file.
* generated/maxloc2_4_s4.c: New file.
* generated/maxloc2_8_s1.c: New file.
* generated/maxloc2_8_s4.c: New file.
* generated/minloc0_16_s1.c: New file.
* generated/minloc0_16_s4.c: New file.
* generated/minloc0_4_s1.c: New file.
* generated/minloc0_4_s4.c: New file.
* generated/minloc0_8_s1.c: New file.
* generated/minloc0_8_s4.c: New file.
* generated/minloc1_16_s1.c: New file.
* generated/minloc1_16_s4.c: New file.
* generated/minloc1_4_s1.c: New file.
* generated/minloc1_4_s4.c: New file.
* generated/minloc1_8_s1.c: New file.
* generated/minloc1_8_s4.c: New file.
* generated/minloc2_16_s1.c: New file.
* generated/minloc2_16_s4.c: New file.
* generated/minloc2_4_s1.c: New file.
* generated/minloc2_4_s4.c: New file.
* generated/minloc2_8_s1.c: New file.
* generated/minloc2_8_s4.c: New file.
* m4/iforeach-s.m4: New file.
* m4/ifunction-s.m4: New file.
* m4/maxloc0s.m4: New file.
* m4/maxloc1s.m4: New file.
* m4/maxloc2s.m4: New file.
* m4/minloc0s.m4: New file.
* m4/minloc1s.m4: New file.
* m4/minloc2s.m4: New file.
* gfortran.map: Add new functions.
* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.
2017-11-19 Thomas Koenig <[email protected]>
PR fortran/36313
* check.c (int_or_real_or_char_check_f2003): New function.
* iresolve.c (gfc_resolve_maxloc): Add number "2" for
character arguments and rank-zero return value.
(gfc_resolve_minloc): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
character arguments and rank-zero return value by removing
unneeded arguments and calling the library function.
2017-11-19 Thomas Koenig <[email protected]>
PR fortran/36313
* gfortran.dg/maxloc_string_1.f90: New test.
* gfortran.dg/minloc_string_1.f90: New test.
p7.diff.gz
Description: application/gzip
! { dg-do run }
! Test maxloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = maxloc(c)
res2 = maxloc(a)
if (any(res1 /= res2)) call abort
res1 = maxloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = maxloc(c,mask=amask)
res2 = maxloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = maxloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = maxloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = maxloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = maxloc(a)
res1 = maxloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = maxloc(c, dim=1)
q2 = maxloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2)
q2 = maxloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (maxloc(e,dim=1) /= maxloc(f,dim=1)) call abort
cmask = .false.
if (maxloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) call abort
end program main
! { dg-do run }
! Test minloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = minloc(c)
res2 = minloc(a)
if (any(res1 /= res2)) call abort
res1 = minloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = minloc(c,mask=amask)
res2 = minloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = minloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = minloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = minloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = minloc(a)
res1 = minloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = minloc(c, dim=1)
q2 = minloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2)
q2 = minloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (minloc(e,dim=1) /= minloc(f,dim=1)) call abort
cmask = .false.
if (minloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( minloc(e, dim=1, mask=cmask) /= minloc (f, dim=1, mask=cmask)) call abort
end program main
