URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [fgetc_3.f90] - Blame information for rev 816

Line No.	Rev	Author	Line
1	149	jeremybenn	`! Testcase for the FGETC and FPUTC intrinsics`
2			`! { dg-do compile }`
3			`character(len=5) s`
4			`integer st`
5
6			`s = "12345"`
7			`open(status="scratch")`
8			`write(*,"(A)") "abcde"`
9			`rewind(10)`
10			`st = fget(s)`
11			`if ((st /= 0) .or. (s /= "a ")) call abort`
12			`st = fget(s)`
13			`close(10)`
14
15			`open(status="scratch")`
16			`s = "12345"`
17			`st = fput(s)`
18			`if (st /= 0) call abort`
19			`st = fput("2")`
20			`if (st /= 0) call abort`
21			`st = fput("3 ")`
22			`if (st /= 0) call abort`
23			`rewind(10)`
24			`st = fget(s)`
25			`if (s(1:1) /= "1") call abort`
26			`st = fget(s)`
27			`if (s(1:1) /= "2") call abort`
28			`st = fget(s)`
29			`if ((s(1:1) /= "3") .or. (st /= 0)) call abort`
30			`st = fget(s)`
31			`if (st /= -1) call abort`
32			`close (10)`
33
34			`end`