|
111
|
1 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
|
|
131
|
27 if (ichar(a(i:i)).ne.32) STOP 1
|
|
111
|
28 end do
|
|
|
29 read (10, 200) a
|
|
|
30 200 format (a60)
|
|
|
31 do i = 1,59
|
|
131
|
32 if (ichar(a(i:i)).ne.32) STOP 2
|
|
111
|
33 end do
|
|
131
|
34 if (a(60:60).ne."*") STOP 3
|
|
111
|
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
|
|
131
|
51 if (ichar(a(i:i)).ne.32) STOP 4
|
|
111
|
52 end do
|
|
131
|
53 if (a(60:60).ne."$") STOP 5
|
|
111
|
54 read (10, 200) a
|
|
131
|
55 if (a(1:10).ne."abcdghijkl") STOP 6
|
|
111
|
56 do i = 11,59
|
|
131
|
57 if (ichar(a(i:i)).ne.32) STOP 7
|
|
111
|
58 end do
|
|
131
|
59 if (a(60:60).ne."*") STOP 8
|
|
111
|
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
|
|
131
|
76 if (ichar(a(i:i)).ne.32) STOP 9
|
|
111
|
77 end do
|
|
131
|
78 if (a(60:60).ne."$") STOP 10
|
|
111
|
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)
|
|
131
|
86 if ((b.ne."#").or.(c.ne."$")) STOP 11
|
|
111
|
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)
|
|
131
|
97 if ((b.ne."#").or.(c.ne."$")) STOP 12
|
|
111
|
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)
|
|
131
|
113 if ((ier.eq.0).or.(ichar(b).ne.0)) STOP 13
|
|
111
|
114
|
|
|
115 c That's all for now, folks!
|
|
|
116
|
|
|
117 end
|
|
|
118
|
