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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [fgetc_2.f90] - Blame information for rev 774

Line No.	Rev	Author	Line
1	694	jeremybenn	`! 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`