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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [x_slash_1.f] - Blame information for rev 801

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

Line No. Rev Author Line
1 694 jeremybenn
c { dg-do run { target fd_truncate } }
2
c { dg-options "-std=legacy" }
3
c
4
c This program tests the fixes to PR22570.
5
c
6
c Provided by Paul Thomas - pault@gcc.gnu.org
7
c
8
       program x_slash
9
       character*60 a
10
       character*1  b, c
11
 
12
       open (10, status = "scratch")
13
 
14
c Check that lines with only x-editing followed by a slash generate
15
c spaces and that subsequent lines have spaces where they should.
16
c Line 1 we ignore.
17
c Line 2 has nothing but x editing, followed by a slash.
18
c Line 3 has x editing finished off by a 1h*
19
 
20
       write (10, 100)
21
 100   format (1h1,58x,1h!,/,60x,/,59x,1h*,/)
22
       rewind (10)
23
 
24
       read (10, 200) a
25
       read (10, 200) a
26
       do i = 1,60
27
         if (ichar(a(i:i)).ne.32) call abort ()
28
       end do
29
       read (10, 200) a
30
 200   format (a60)
31
       do i = 1,59
32
         if (ichar(a(i:i)).ne.32) call abort ()
33
       end do
34
       if (a(60:60).ne."*") call abort ()
35
       rewind (10)
36
 
37
c Check that sequences of t- and x-editing generate the correct 
38
c number of spaces.
39
c Line 1 we ignore.
40
c Line 2 has tabs to the right of present position.
41
c Line 3 has tabs to the left of present position.
42
 
43
       write (10, 101)
44
 101   format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/,
45
     >         6habcdef,tl4,2x,6hghijkl,t1,59x,1h*)
46
       rewind (10)
47
 
48
       read (10, 200) a
49
       read (10, 200) a
50
       do i = 1,59
51
         if (ichar(a(i:i)).ne.32) call abort ()
52
       end do
53
       if (a(60:60).ne."$") call abort ()
54
       read (10, 200) a
55
       if (a(1:10).ne."abcdghijkl") call abort ()
56
       do i = 11,59
57
         if (ichar(a(i:i)).ne.32) call abort ()
58
       end do
59
       if (a(60:60).ne."*") call abort ()
60
       rewind (10)
61
 
62
c Now repeat the first test, with the write broken up into three
63
c separate statements. This checks that the position counters are
64
c correctly reset for each statement.
65
 
66
       write (10,102) "#"
67
       write (10,103)
68
       write (10,102) "$"
69
 102   format(59x,a1)
70
 103   format(60x)
71
       rewind (10)
72
       read (10, 200) a
73
       read (10, 200) a
74
       read (10, 200) a
75
       do i = 11,59
76
         if (ichar(a(i:i)).ne.32) call abort ()
77
       end do
78
       if (a(60:60).ne."$") call abort ()
79
       rewind (10)
80
 
81
c Next we check multiple read x- and t-editing.
82
c First, tab to the right.
83
 
84
       read (10, 201) b, c
85
201    format (tr10,49x,a1,/,/,2x,t60,a1)
86
       if ((b.ne."#").or.(c.ne."$")) call abort ()
87
       rewind (10)
88
 
89
c Now break it up into three reads and use left tabs.
90
 
91
       read (10, 202) b
92
202    format (10x,tl10,59x,a1)
93
       read (10, 203)
94
203    format ()
95
       read (10, 204) c
96
204    format (10x,t5,55x,a1)
97
       if ((b.ne."#").or.(c.ne."$")) call abort ()
98
       close (10)
99
 
100
c Now, check that trailing spaces are not transmitted when we have
101
c run out of data (Thanks to Jack Howarth for finding this one:
102
c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html).
103
 
104
       open (10, pad = "no", status = "scratch")
105
       b = achar (0)
106
       write (10, 105) 42
107
  105  format (i10,1x,i10)
108
       write (10, 106)
109
  106  format ("============================")
110
       rewind (10)
111
       read (10, 205, iostat = ier) i, b
112
  205  format (i10,a1)
113
       if ((ier.eq.0).or.(ichar(b).ne.0)) call abort ()
114
 
115
c That's all for now, folks! 
116
 
117
       end
118
 

powered by: WebSVN 2.1.0

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