gcc/testsuite/gfortran.dg/string_compare_2.f90

   1 ! { dg-do run }
   2
   3 ! PR fortran/37099
   4 ! Check for correct results when comparing array-section-substrings.
   5
   6 ! This is the original test from the PR.
   7 ! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
   8
   9 module xparams
  10   integer,parameter :: exprbeg=100,exprend=154
  11   character(*),dimension(exprbeg:exprend),parameter :: &
  12       exprs=(/'nint()  ','log10() ','sqrt()  ','acos()  ','asin()  ',   &
  13       'atan()  ','cosh()  ','sinh()  ','tanh()  ','int()   ',           &
  14       'cos()   ','sin()   ','tan()   ','exp()   ','log()   ','abs()   ',&
  15       'delta() ','step()  ','rect()  ','max(,)  ','min(,)  ','bj0()   ',&
  16       'bj1()   ','bjn(,)  ','by0()   ','by1()   ','byn(,)  ','logb(,) ',&
  17       'erf()   ','erfc()  ','lgamma()','gamma() ','csch()  ','sech()  ',&
  18       'coth()  ','lif(,,) ','gaus()  ','sinc()  ','atan2(,)','mod(,)  ',&
  19       'nthrt(,)','ramp()  ','fbi()   ','fbiq()  ','uran(,) ','aif(,,,)',&
  20       'sgn()   ','cbrt()  ','fact()  ','somb()  ','bk0()   ','bk1()   ',&
  21       'bkn(,)  ','bbi(,,) ','bbiq(,,)'/)
  22   logical :: tmp(55,26)
  23   character(26) :: al = 'abcdefghijklmnopqrstuvwxyz'
  24 end
  25
  26 program pack_bug
  27   use xparams
  28     do i = 1, 1
  29       tmp(:,i) = (exprs(:)(1:1)==al(i:i))
  30       print '(55L1)', exprs(:)(1:1)=='a'
  31       print '(55L1)', tmp(:,i)
  32
  33       if (any ((exprs(:)(1:1)=='a') .neqv. tmp(:,i))) then
  34         call abort ()
  35       end if
  36     end do
  37 end