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") call abort() 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') call abort() 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") call abort() 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") call abort() 44 if (c /= "aa") call abort() 45 END 46 47 call test1() 48 call test2() 49 call test3() 50 call test4() 51 end 52