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