Hello world,

here is the latest take on the min/maxloc ABI change for BACK.
This version now passes BACK as a GFC_LOGCIAL_4 by value in all cases.
I did this by using the existing %VAL mechanism. I also added
another test case which crashed during one stage of development.

So, OK for trunk?

Regards

        Thomas

2018-01-14  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/54613
        * gfortran.h (gfc_check_f): Rename f4ml to f5ml.
        (gfc_logical_4_kind): New macro
        * intrinsic.h (gfc_simplify_minloc): Add a gfc_expr *argument.
        (gfc_simplify_maxloc): Likewise.
        (gfc_resolve_maxloc): Likewise.
        (gfc_resolve_minloc): Likewise.
        * check.c (gfc_check_minloc_maxloc): Add checking for "back"
        argument; also raise error if it is used (for now). Add it
        if it isn't present.
        * intrinsic.c (add_sym_4ml): Rename to
        (add_sym_5ml), adjust for extra argument.
        (add_functions): Add "back" constant. Adjust maxloc and minloc
        for back argument.
        * iresolve.c (gfc_resolve_maxloc): Add back argument. If back is
        not of gfc_logical_4_kind, convert.
        (gfc_resolve_minloc): Likewise.
        * simplify.c (gfc_simplify_minloc): Add back argument.
        (gfc_simplify_maxloc): Likewise.
        * trans-intinsic.c (gfc_conv_intrinsic_minmaxloc): Rename last
        argument to %VAL to ensure passing by value.
        (gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_minmaxloc
        also for library calls.

2018-01-14  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/54613
        * m4/iparm.m4: Add back_arg macro if in minloc or maxloc.
        * m4/iforeach-s.m4: Add optional argument back with back_arg
        macro. Improve m4 quoting. If HAVE_BACK_ARG is defined, assert
        that back is non-true.
        * m4/iforeach.m4: Likewise.
        * m4/ifunction-s.m4: Likewise.
        * m4/ifunction.m4: Likewise.
        * m4/maxloc0.m4: Include assert.h
        * m4/minloc0.m4: Likewise.
        * m4/maxloc0s.m4: #define HAVE_BACK_ARG.
        * m4/minloc0s.m4: Likewise.
        * m4/maxloc1s.m4: Likewise.
        * m4/minloc1s.m4: Likewise.
        * m4/maxloc1.m4: Include assert.h, #define HAVE_BACK_ARG.
        * m4/minloc1.m4: Likewise.
        * m4/maxloc2s.m4: Add assert.h, add back_arg, assert that
        back is non-true.
        * m4/minloc2s.m4: Likewise.
        * generated/iall_i1.c: Regenerated.
        * generated/iall_i16.c: Regenerated.
        * generated/iall_i2.c: Regenerated.
        * generated/iall_i4.c: Regenerated.
        * generated/iall_i8.c: Regenerated.
        * generated/iany_i1.c: Regenerated.
        * generated/iany_i16.c: Regenerated.
        * generated/iany_i2.c: Regenerated.
        * generated/iany_i4.c: Regenerated.
        * generated/iany_i8.c: Regenerated.
        * generated/iparity_i1.c: Regenerated.
        * generated/iparity_i16.c: Regenerated.
        * generated/iparity_i2.c: Regenerated.
        * generated/iparity_i4.c: Regenerated.
        * generated/iparity_i8.c: Regenerated.
        * generated/maxloc0_16_i1.c: Regenerated.
        * generated/maxloc0_16_i16.c: Regenerated.
        * generated/maxloc0_16_i2.c: Regenerated.
        * generated/maxloc0_16_i4.c: Regenerated.
        * generated/maxloc0_16_i8.c: Regenerated.
        * generated/maxloc0_16_r10.c: Regenerated.
        * generated/maxloc0_16_r16.c: Regenerated.
        * generated/maxloc0_16_r4.c: Regenerated.
        * generated/maxloc0_16_r8.c: Regenerated.
        * generated/maxloc0_16_s1.c: Regenerated.
        * generated/maxloc0_16_s4.c: Regenerated.
        * generated/maxloc0_4_i1.c: Regenerated.
        * generated/maxloc0_4_i16.c: Regenerated.
        * generated/maxloc0_4_i2.c: Regenerated.
        * generated/maxloc0_4_i4.c: Regenerated.
        * generated/maxloc0_4_i8.c: Regenerated.
        * generated/maxloc0_4_r10.c: Regenerated.
        * generated/maxloc0_4_r16.c: Regenerated.
        * generated/maxloc0_4_r4.c: Regenerated.
        * generated/maxloc0_4_r8.c: Regenerated.
        * generated/maxloc0_4_s1.c: Regenerated.
        * generated/maxloc0_4_s4.c: Regenerated.
        * generated/maxloc0_8_i1.c: Regenerated.
        * generated/maxloc0_8_i16.c: Regenerated.
        * generated/maxloc0_8_i2.c: Regenerated.
        * generated/maxloc0_8_i4.c: Regenerated.
        * generated/maxloc0_8_i8.c: Regenerated.
        * generated/maxloc0_8_r10.c: Regenerated.
        * generated/maxloc0_8_r16.c: Regenerated.
        * generated/maxloc0_8_r4.c: Regenerated.
        * generated/maxloc0_8_r8.c: Regenerated.
        * generated/maxloc0_8_s1.c: Regenerated.
        * generated/maxloc0_8_s4.c: Regenerated.
        * generated/maxloc1_16_i1.c: Regenerated.
        * generated/maxloc1_16_i16.c: Regenerated.
        * generated/maxloc1_16_i2.c: Regenerated.
        * generated/maxloc1_16_i4.c: Regenerated.
        * generated/maxloc1_16_i8.c: Regenerated.
        * generated/maxloc1_16_r10.c: Regenerated.
        * generated/maxloc1_16_r16.c: Regenerated.
        * generated/maxloc1_16_r4.c: Regenerated.
        * generated/maxloc1_16_r8.c: Regenerated.
        * generated/maxloc1_16_s1.c: Regenerated.
        * generated/maxloc1_16_s4.c: Regenerated.
        * generated/maxloc1_4_i1.c: Regenerated.
        * generated/maxloc1_4_i16.c: Regenerated.
        * generated/maxloc1_4_i2.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/maxloc1_4_r10.c: Regenerated.
        * generated/maxloc1_4_r16.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/maxloc1_4_s1.c: Regenerated.
        * generated/maxloc1_4_s4.c: Regenerated.
        * generated/maxloc1_8_i1.c: Regenerated.
        * generated/maxloc1_8_i16.c: Regenerated.
        * generated/maxloc1_8_i2.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/maxloc1_8_r10.c: Regenerated.
        * generated/maxloc1_8_r16.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/maxloc1_8_s1.c: Regenerated.
        * generated/maxloc1_8_s4.c: Regenerated.
        * generated/maxval_i1.c: Regenerated.
        * generated/maxval_i16.c: Regenerated.
        * generated/maxval_i2.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/maxval_r10.c: Regenerated.
        * generated/maxval_r16.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/minloc0_16_i1.c: Regenerated.
        * generated/minloc0_16_i16.c: Regenerated.
        * generated/minloc0_16_i2.c: Regenerated.
        * generated/minloc0_16_i4.c: Regenerated.
        * generated/minloc0_16_i8.c: Regenerated.
        * generated/minloc0_16_r10.c: Regenerated.
        * generated/minloc0_16_r16.c: Regenerated.
        * generated/minloc0_16_r4.c: Regenerated.
        * generated/minloc0_16_r8.c: Regenerated.
        * generated/minloc0_16_s1.c: Regenerated.
        * generated/minloc0_16_s4.c: Regenerated.
        * generated/minloc0_4_i1.c: Regenerated.
        * generated/minloc0_4_i16.c: Regenerated.
        * generated/minloc0_4_i2.c: Regenerated.
        * generated/minloc0_4_i4.c: Regenerated.
        * generated/minloc0_4_i8.c: Regenerated.
        * generated/minloc0_4_r10.c: Regenerated.
        * generated/minloc0_4_r16.c: Regenerated.
        * generated/minloc0_4_r4.c: Regenerated.
        * generated/minloc0_4_r8.c: Regenerated.
        * generated/minloc0_4_s1.c: Regenerated.
        * generated/minloc0_4_s4.c: Regenerated.
        * generated/minloc0_8_i1.c: Regenerated.
        * generated/minloc0_8_i16.c: Regenerated.
        * generated/minloc0_8_i2.c: Regenerated.
        * generated/minloc0_8_i4.c: Regenerated.
        * generated/minloc0_8_i8.c: Regenerated.
        * generated/minloc0_8_r10.c: Regenerated.
        * generated/minloc0_8_r16.c: Regenerated.
        * generated/minloc0_8_r4.c: Regenerated.
        * generated/minloc0_8_r8.c: Regenerated.
        * generated/minloc0_8_s1.c: Regenerated.
        * generated/minloc0_8_s4.c: Regenerated.
        * generated/minloc1_16_i1.c: Regenerated.
        * generated/minloc1_16_i16.c: Regenerated.
        * generated/minloc1_16_i2.c: Regenerated.
        * generated/minloc1_16_i4.c: Regenerated.
        * generated/minloc1_16_i8.c: Regenerated.
        * generated/minloc1_16_r10.c: Regenerated.
        * generated/minloc1_16_r16.c: Regenerated.
        * generated/minloc1_16_r4.c: Regenerated.
        * generated/minloc1_16_r8.c: Regenerated.
        * generated/minloc1_16_s1.c: Regenerated.
        * generated/minloc1_16_s4.c: Regenerated.
        * generated/minloc1_4_i1.c: Regenerated.
        * generated/minloc1_4_i16.c: Regenerated.
        * generated/minloc1_4_i2.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_r10.c: Regenerated.
        * generated/minloc1_4_r16.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/minloc1_4_s1.c: Regenerated.
        * generated/minloc1_4_s4.c: Regenerated.
        * generated/minloc1_8_i1.c: Regenerated.
        * generated/minloc1_8_i16.c: Regenerated.
        * generated/minloc1_8_i2.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/minloc1_8_r10.c: Regenerated.
        * generated/minloc1_8_r16.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/minloc1_8_s1.c: Regenerated.
        * generated/minloc1_8_s4.c: Regenerated.
        * generated/minval_i1.c: Regenerated.
        * generated/minval_i16.c: Regenerated.
        * generated/minval_i2.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/minval_r10.c: Regenerated.
        * generated/minval_r16.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/norm2_r10.c: Regenerated.
        * generated/norm2_r16.c: Regenerated.
        * generated/norm2_r4.c: Regenerated.
        * generated/norm2_r8.c: Regenerated.
        * generated/parity_l1.c: Regenerated.
        * generated/parity_l16.c: Regenerated.
        * generated/parity_l2.c: Regenerated.
        * generated/parity_l4.c: Regenerated.
        * generated/parity_l8.c: Regenerated.
        * generated/product_c10.c: Regenerated.
        * generated/product_c16.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/product_i1.c: Regenerated.
        * generated/product_i16.c: Regenerated.
        * generated/product_i2.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/product_r10.c: Regenerated.
        * generated/product_r16.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/sum_c10.c: Regenerated.
        * generated/sum_c16.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/sum_i1.c: Regenerated.
        * generated/sum_i16.c: Regenerated.
        * generated/sum_i2.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/sum_r10.c: Regenerated.
        * generated/sum_r16.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/sum_r8.c: Regenerated.

2018-01-07  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/54613
        * gfortran.dg/minmaxloc_9.f90: New test.
        * gfortran.dg/minmaxloc_10.f90: New test.
        * gfortran.dg/minmaxloc_11.f90: New test.
! { dg-do  run }
program main
  character(len=3), dimension(2) :: a
  a(1) = 'aaa'
  a(2) = 'bbb'
  if (maxloc(a,dim=1) /= 2) call abort
  if (minloc(a,dim=1) /= 1) call abort

end program main

Attachment: p3.diff.gz
Description: application/gzip

! { dg-do compile }
! Check for a few restrictions on the back argument to
! minloc and maxloc.
program main
  integer, dimension(3) :: a
  a = [1,2,3]
  print *,minloc(a,back=42) ! { dg-error "must be LOGICAL" }
  print *,minloc(a,back=[.true.,.false.]) ! { dg-error "must be a scalar" }
  print *,maxloc(a,back=42) ! { dg-error "must be LOGICAL" }
  print *,maxloc(a,back=[.true.,.false.]) ! { dg-error "must be a scalar" }
end program main
! { dg-do run }
! { dg-additional-options "-fdefault-integer-8" }
! Check max/minloc with eight-bytes logicals.
!
program test
  implicit none
  integer :: i(1), j(-1:1), res(1)
  logical, volatile :: m(3), m2(3)
  m = (/ .false., .false., .false. /)
  m2 = (/ .false., .true., .false. /)
  call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
  call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
  call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
  call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
  call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
  call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
  call check(7, 0, MAXLOC(i(1:0), DIM=1))
  call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
  call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
  call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
  call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
  call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
  call check(13,0, MINLOC(i(1:0), DIM=1))

  j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
  j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
  j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
  j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
  j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
  j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))

  j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
  j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
  j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
  j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
  j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
  j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))

  j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
  j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
  j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
  j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
  j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
  j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))

  j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
  j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
  j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
  j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
  j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
  j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))

  j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
  j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
  j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
  j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
  j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
  j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))

! Check the library minloc and maxloc
  res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0,  res(1))
  res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0,  res(1))
  res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2,  res(1))
  res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0,  res(1))
  res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0,  res(1))
  res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0,  res(1))
  res = MAXLOC(i(1:0)); call check(50, 0,  res(1))
  res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
  res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
  res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
  res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
  res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
  res = MINLOC(i(1:0)); call check(56,0, res(1))

  j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2,  res(1))
  j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3,  res(1))
  j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1,  res(1))
  j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
  j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
  j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))

  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2,  res(1))
  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3,  res(1))
  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1,  res(1))
  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))

  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0,  res(1))
  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0,  res(1))
  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0,  res(1))
  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))

  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0,  res(1))
  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0,  res(1))
  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0,  res(1))
  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))

  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2,  res(1))
  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2,  res(1))
  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2,  res(1))
  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))

contains
subroutine check(n, i,j)
  integer, value, intent(in) :: i,j,n
  if(i /= j) then
     call abort()
!    print *, 'ERROR: Test',n,' expected ',i,' received ', j
  end if
end subroutine check
end program

Reply via email to