gcc/testsuite/gfortran.dg/string_4.f90

   1 ! { dg-do compile }
   2 ! { dg-options "" }
   3 ! (options to disable warnings about statement functions etc.)
   4 !
   5 ! PR fortran/44352
   6 !
   7 ! Contributed by Vittorio Zecca
   8 !
   9
  10       SUBROUTINE TEST1()
  11       implicit real*8 (a-h,o-z)
  12       character*32 ddname,stmtfnt1
  13       stmtfnt1(x)=   'h810 e=0.01         '
  14       ddname=stmtfnt1(0.d0)
  15       if (ddname /= "h810 e=0.01") STOP 1
  16       END
  17
  18       SUBROUTINE TEST2()
  19       implicit none
  20       character(2)  :: ddname,stmtfnt2
  21       real :: x
  22       stmtfnt2(x)=   'x'
  23       ddname=stmtfnt2(0.0)
  24       if(ddname /= 'x') STOP 2
  25       END
  26
  27       SUBROUTINE TEST3()
  28       implicit real*8 (a-h,o-z)
  29       character*32 ddname,dname
  30       character*2 :: c
  31       dname(c) = 'h810 e=0.01         '
  32       ddname=dname("w ")
  33       if (ddname /= "h810 e=0.01") STOP 3
  34       END
  35
  36       SUBROUTINE TEST4()
  37       implicit real*8 (a-h,o-z)
  38       character*32 ddname,dname
  39       character*2 :: c
  40       dname(c) = 'h810 e=0.01         '
  41       c = 'aa'
  42       ddname=dname("w ")
  43       if (ddname /= "h810 e=0.01") STOP 4
  44       if (c /= "aa") STOP 5
  45       END
  46
  47       call test1()
  48       call test2()
  49       call test3()
  50       call test4()
  51       end