1! Testcase for the FGETC and FPUTC intrinsics 2! { dg-do run } 3 character(len=5) s 4 integer st 5 6 s = "12345" 7 open(10,status="scratch") 8 write(10,"(A)") "abcde" 9 rewind(10) 10 call fgetc(10,s,st) 11 if ((st /= 0) .or. (s /= "a ")) call abort 12 call fgetc(10,s,st) 13 close(10) 14 15 open(10,status="scratch") 16 s = "12345" 17 call fputc(10,s,st) 18 if (st /= 0) call abort 19 call fputc(10,"2",st) 20 if (st /= 0) call abort 21 call fputc(10,"3 ",st) 22 if (st /= 0) call abort 23 rewind(10) 24 call fgetc(10,s) 25 if (s(1:1) /= "1") call abort 26 call fgetc(10,s) 27 if (s(1:1) /= "2") call abort 28 call fgetc(10,s,st) 29 if ((s(1:1) /= "3") .or. (st /= 0)) call abort 30 call fgetc(10,s,st) 31 if (st /= -1) call abort 32 close (10) 33 34! FGETC and FPUTC on units not opened should not work 35 call fgetc(12,s,st) 36 if (st /= -1) call abort 37 call fputc(12,s,st) 38 if (st /= -1) call abort 39 end 40