gcc/testsuite/gfortran.dg/intrinsic_ifunction_1.f90

   1 ! { dg-do run }
   2 ! PR 35995 - ifunction.m4 and ifunction_logical.m4 had a bug
   3 ! where zero-sized arguments were not handled correctly.
   4 ! Test case provided by Dick Hendrickson, amended by
   5 ! Thomas Koenig.
   6
   7       program try_gf0026_etc
   8
   9       call       gf0026(  0,  1)
  10       call       foo   (  0,  1)
  11
  12       end program
  13
  14       SUBROUTINE GF0026(nf0,nf1)
  15       LOGICAL LDA(9)
  16       INTEGER IDA(NF0,9), iii(9)
  17
  18       lda = (/ (i/2*2 .eq. I, i=1,9) /)
  19       LDA = ALL ( IDA .NE. -1000,  1)
  20       if (.not. all(lda)) call abort
  21       if (.not. all(ida .ne. -1000)) call abort
  22
  23       lda = (/ (i/2*2 .eq. I, i=1,9) /)
  24       LDA = any ( IDA .NE. -1000,  1)
  25       print *, lda          !expect FALSE
  26       if (any(lda)) call abort
  27       print *, any(ida .ne. -1000)   !expect FALSE
  28       if (any(ida .ne. -1000)) call abort
  29
  30       iii = 137
  31       iii = count ( IDA .NE. -1000,  1)
  32       if (any(iii /= 0)) call abort
  33       if (count(ida .ne. -1000) /= 0) call abort
  34
  35       END SUBROUTINE
  36
  37       subroutine foo (nf0, nf1)
  38       integer, dimension(9):: res, iii
  39       integer, dimension(nf0,9) :: ida
  40       res = (/ (-i, i=1,9) /)
  41       res = product (ida, 1)
  42       if (any(res /= 1)) call abort
  43       end subroutine foo