Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/x_slash_1.f @ 111:04ced10e8804
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 |