OSDN Git Service

2010-04-24 Kai Tietz <kai.tietz@onevision.com>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / fgetc_2.f90
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   st = fgetc(10,s)
11   if ((st /= 0) .or. (s /= "a    ")) call abort
12   st = fgetc(10,s)
13   close(10)
14
15   open(10,status="scratch")
16   s = "12345"
17   st = fputc(10,s)
18   if (st /= 0) call abort
19   st = fputc(10,"2")
20   if (st /= 0) call abort
21   st = fputc(10,"3 ")
22   if (st /= 0) call abort
23   rewind(10)
24   st = fgetc(10,s)
25   if (s(1:1) /= "1") call abort
26   st = fgetc(10,s)
27   if (s(1:1) /= "2") call abort
28   st = fgetc(10,s)
29   if ((s(1:1) /= "3") .or. (st /= 0)) call abort
30   st = fgetc(10,s)
31   if (st /= -1) call abort
32   close (10)
33
34 ! FGETC and FPUTC on units not opened should not work
35   st = fgetc(12,s)
36   if (st /= -1) call abort
37   st = fputc(12,s)
38   if (st /= -1) call abort
39   end