OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

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

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.