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 <tkoe...@gcc.gnu.org> 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 <tkoe...@gcc.gnu.org> 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 <tkoe...@gcc.gnu.org> 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