1c { dg-do run { target fd_truncate } }
2c { dg-options "-std=legacy" }
3c
4c This program tests the fixes to PR22570.
5c
6c Provided by Paul Thomas - pault@gcc.gnu.org
7c
8       program x_slash
9       character*60 a
10       character*1  b, c
11
12       open (10, status = "scratch")
13
14c Check that lines with only x-editing followed by a slash generate
15c spaces and that subsequent lines have spaces where they should.
16c Line 1 we ignore.
17c Line 2 has nothing but x editing, followed by a slash.
18c 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) STOP 1
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) STOP 2
33       end do
34       if (a(60:60).ne."*") STOP 3
35       rewind (10)
36
37c Check that sequences of t- and x-editing generate the correct
38c number of spaces.
39c Line 1 we ignore.
40c Line 2 has tabs to the right of present position.
41c 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) STOP 4
52       end do
53       if (a(60:60).ne."$") STOP 5
54       read (10, 200) a
55       if (a(1:10).ne."abcdghijkl") STOP 6
56       do i = 11,59
57         if (ichar(a(i:i)).ne.32) STOP 7
58       end do
59       if (a(60:60).ne."*") STOP 8
60       rewind (10)
61
62c Now repeat the first test, with the write broken up into three
63c separate statements. This checks that the position counters are
64c 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) STOP 9
77       end do
78       if (a(60:60).ne."$") STOP 10
79       rewind (10)
80
81c Next we check multiple read x- and t-editing.
82c First, tab to the right.
83
84       read (10, 201) b, c
85201    format (tr10,49x,a1,/,/,2x,t60,a1)
86       if ((b.ne."#").or.(c.ne."$")) STOP 11
87       rewind (10)
88
89c Now break it up into three reads and use left tabs.
90
91       read (10, 202) b
92202    format (10x,tl10,59x,a1)
93       read (10, 203)
94203    format ()
95       read (10, 204) c
96204    format (10x,t5,55x,a1)
97       if ((b.ne."#").or.(c.ne."$")) STOP 12
98       close (10)
99
100c Now, check that trailing spaces are not transmitted when we have
101c run out of data (Thanks to Jack Howarth for finding this one:
102c 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)) STOP 13
114
115c That's all for now, folks!
116
117       end
118
119