gcc/testsuite/gfortran.dg/intrinsic_product_1.f90

   1 ! { dg-do run }
   2 ! PR 35993 - some intrinsics with mask = .false. didn't set
   3 ! the whole return array for multi-dimensional arrays.
   4 ! Test case adapted from Dick Hendrickson.
   5
   6       program try
   7
   8       call       ga3019(  1,  2,  3,  4)
   9       end program
  10
  11       SUBROUTINE GA3019(nf1,nf2,nf3,nf4)
  12       INTEGER IDA(NF2,NF3)
  13       INTEGER IDA1(NF2,NF4,NF3)
  14
  15       ida1 = 3
  16
  17       ida = -3
  18       IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, NF1 .LT. 0)  !fails
  19       if (any(ida /= 1)) call abort
  20
  21       ida = -3
  22       IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, .false. )    !fails
  23       if (any(ida /= 1)) call abort
  24
  25       ida = -3
  26       IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, ida1 .eq. 137 )    !works
  27       if (any(ida /= 1)) call abort
  28
  29       END SUBROUTINE