[patch, fortran] Implement maxloc and minloc for character

[Thomas Koenig <tkoenig at netcologne dot de>]

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

        PR fortran/36313
        * gfortran.dg/maxloc_string_1.f90: New test.
        * gfortran.dg/minloc_string_1.f90: New test.

Attachment: 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