1 ! Testcase for the FGETC and FPUTC intrinsics
2 ! { dg-do run { target fd_truncate } }
7 open(10,status="scratch")
8 write(10,"(A)") "abcde"
11 if ((st /= 0) .or. (s /= "a ")) call abort
15 open(10,status="scratch")
18 if (st /= 0) call abort
20 if (st /= 0) call abort
21 call fputc(10,"3 ",st)
22 if (st /= 0) call abort
25 if (s(1:1) /= "1") call abort
27 if (s(1:1) /= "2") call abort
29 if ((s(1:1) /= "3") .or. (st /= 0)) call abort
31 if (st /= -1) call abort
34 ! FGETC and FPUTC on units not opened should not work
36 if (st /= -1) call abort
38 if (st /= -1) call abort