Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/x_slash_1.f @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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
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