1 c { dg-do run { target fd_truncate } }
2 c This program tests the fixes to PR22570.
4 c Provided by Paul Thomas - pault@gcc.gnu.org
10 open
(10, status
= "scratch")
12 c Check that lines with only x-editing followed by a slash generate
13 c spaces and that subsequent lines have spaces where they should.
15 c Line 2 has nothing but x editing, followed by a slash.
16 c Line 3 has x editing finished off by a 1h*
19 100 format (1h1
,58x
,1h
!,/,60x
,/,59x
,1h*
,/)
25 if (ichar
(a
(i
:i
)).ne
.32) call abort
()
30 if (ichar
(a
(i
:i
)).ne
.32) call abort
()
32 if (a
(60:60).ne
."*") call abort
()
35 c Check that sequences of t- and x-editing generate the correct
38 c Line 2 has tabs to the right of present position.
39 c Line 3 has tabs to the left of present position.
42 101 format (1h1
,58x
,1h#
,/,t38
,2x
,1h
,tr10
,9x
,1h$
,/,
43 > 6habcdef
,tl4
,2x
,6hghijkl
,t1
,59x
,1h*
)
49 if (ichar
(a
(i
:i
)).ne
.32) call abort
()
51 if (a
(60:60).ne
."$") call abort
()
53 if (a
(1:10).ne
."abcdghijkl") call abort
()
55 if (ichar
(a
(i
:i
)).ne
.32) call abort
()
57 if (a
(60:60).ne
."*") call abort
()
60 c Now repeat the first test, with the write broken up into three
61 c separate statements. This checks that the position counters are
62 c correctly reset for each statement.
74 if (ichar
(a
(i
:i
)).ne
.32) call abort
()
76 if (a
(60:60).ne
."$") call abort
()
79 c Next we check multiple read x- and t-editing.
80 c First, tab to the right.
83 201 format (tr10
,49x
,a1
,/,/,2x
,t60
,a1
)
84 if ((b
.ne
."#").or
.(c
.ne
."$")) call abort
()
87 c Now break it up into three reads and use left tabs.
90 202 format (10x
,tl10
,59x
,a1
)
94 204 format (10x
,t5
,55x
,a1
)
95 if ((b
.ne
."#").or
.(c
.ne
."$")) call abort
()
98 c Now, check that trailing spaces are not transmitted when we have
99 c run out of data (Thanks to Jack Howarth for finding this one:
100 c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html).
102 open
(10, pad
= "no", status
= "scratch")
105 105 format (i10
,1x
,i10
)
107 106 format ("============================")
109 read (10, 205, iostat
= ier
) i
, b
111 if ((ier
.eq
.0).or
.(ichar
(b
).ne
.0)) call abort
()
113 c That's all for now, folks!