Commit | Line | Data |
a687059c |
1 | #!./perl |
2 | |
784707d5 |
3 | print "1..11\n"; |
a687059c |
4 | |
3fe9a6f1 |
5 | my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; |
6 | |
a687059c |
7 | format OUT = |
8 | the quick brown @<< |
9 | $fox |
10 | jumped |
11 | @* |
12 | $multiline |
13 | ^<<<<<<<<< |
14 | $foo |
15 | ^<<<<<<<<< |
16 | $foo |
17 | ^<<<<<<... |
18 | $foo |
19 | now @<<the@>>>> for all@|||||men to come @<<<< |
a0d0e21e |
20 | { |
21 | 'i' . 's', "time\n", $good, 'to' |
22 | } |
a687059c |
23 | . |
24 | |
a0d0e21e |
25 | open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
a687059c |
26 | |
27 | $fox = 'foxiness'; |
28 | $good = 'good'; |
29 | $multiline = "forescore\nand\nseven years\n"; |
30 | $foo = 'when in the course of human events it becomes necessary'; |
31 | write(OUT); |
32 | close OUT; |
33 | |
34 | $right = |
35 | "the quick brown fox |
36 | jumped |
37 | forescore |
38 | and |
39 | seven years |
40 | when in |
41 | the course |
42 | of huma... |
43 | now is the time for all good men to come to\n"; |
44 | |
3fe9a6f1 |
45 | if (`$CAT Op_write.tmp` eq $right) |
784707d5 |
46 | { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; } |
a687059c |
47 | else |
48 | { print "not ok 1\n"; } |
49 | |
748a9306 |
50 | $fox = 'wolfishness'; |
51 | my $fox = 'foxiness'; # Test a lexical variable. |
52 | |
a687059c |
53 | format OUT2 = |
54 | the quick brown @<< |
55 | $fox |
56 | jumped |
57 | @* |
58 | $multiline |
59 | ^<<<<<<<<< ~~ |
60 | $foo |
61 | now @<<the@>>>> for all@|||||men to come @<<<< |
62 | 'i' . 's', "time\n", $good, 'to' |
63 | . |
64 | |
a0d0e21e |
65 | open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp"; |
a687059c |
66 | |
a687059c |
67 | $good = 'good'; |
68 | $multiline = "forescore\nand\nseven years\n"; |
69 | $foo = 'when in the course of human events it becomes necessary'; |
70 | write(OUT2); |
71 | close OUT2; |
72 | |
73 | $right = |
74 | "the quick brown fox |
75 | jumped |
76 | forescore |
77 | and |
78 | seven years |
79 | when in |
80 | the course |
81 | of human |
82 | events it |
83 | becomes |
84 | necessary |
85 | now is the time for all good men to come to\n"; |
86 | |
3fe9a6f1 |
87 | if (`$CAT Op_write.tmp` eq $right) |
784707d5 |
88 | { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; } |
a687059c |
89 | else |
90 | { print "not ok 2\n"; } |
91 | |
0f85fab0 |
92 | eval <<'EOFORMAT'; |
93 | format OUT2 = |
94 | the brown quick @<< |
95 | $fox |
96 | jumped |
97 | @* |
98 | $multiline |
a0d0e21e |
99 | and |
0f85fab0 |
100 | ^<<<<<<<<< ~~ |
101 | $foo |
102 | now @<<the@>>>> for all@|||||men to come @<<<< |
103 | 'i' . 's', "time\n", $good, 'to' |
104 | . |
105 | EOFORMAT |
106 | |
a0d0e21e |
107 | open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
0f85fab0 |
108 | |
109 | $fox = 'foxiness'; |
110 | $good = 'good'; |
111 | $multiline = "forescore\nand\nseven years\n"; |
112 | $foo = 'when in the course of human events it becomes necessary'; |
113 | write(OUT2); |
114 | close OUT2; |
115 | |
116 | $right = |
117 | "the brown quick fox |
118 | jumped |
119 | forescore |
120 | and |
121 | seven years |
a0d0e21e |
122 | and |
0f85fab0 |
123 | when in |
124 | the course |
125 | of human |
126 | events it |
127 | becomes |
128 | necessary |
129 | now is the time for all good men to come to\n"; |
130 | |
3fe9a6f1 |
131 | if (`$CAT Op_write.tmp` eq $right) |
784707d5 |
132 | { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; } |
0f85fab0 |
133 | else |
134 | { print "not ok 3\n"; } |
135 | |
55497cff |
136 | # formline tests |
137 | |
138 | $mustbe = <<EOT; |
139 | @ a |
140 | @> ab |
141 | @>> abc |
142 | @>>> abc |
143 | @>>>> abc |
144 | @>>>>> abc |
145 | @>>>>>> abc |
146 | @>>>>>>> abc |
147 | @>>>>>>>> abc |
148 | @>>>>>>>>> abc |
149 | @>>>>>>>>>> abc |
150 | EOT |
151 | |
152 | $was1 = $was2 = ''; |
153 | for (0..10) { |
154 | # lexical picture |
155 | $^A = ''; |
156 | my $format1 = '@' . '>' x $_; |
157 | formline $format1, 'abc'; |
158 | $was1 .= "$format1 $^A\n"; |
159 | # global |
160 | $^A = ''; |
161 | local $format2 = '@' . '>' x $_; |
162 | formline $format2, 'abc'; |
163 | $was2 .= "$format2 $^A\n"; |
164 | } |
165 | print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n"; |
166 | print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n"; |
167 | |
7056ecde |
168 | $^A = ''; |
169 | |
170 | # more test |
171 | |
172 | format OUT3 = |
173 | ^<<<<<<... |
174 | $foo |
175 | . |
176 | |
177 | open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
178 | |
179 | $foo = 'fit '; |
180 | write(OUT3); |
181 | close OUT3; |
182 | |
183 | $right = |
184 | "fit\n"; |
185 | |
186 | if (`$CAT Op_write.tmp` eq $right) |
784707d5 |
187 | { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; } |
7056ecde |
188 | else |
189 | { print "not ok 6\n"; } |
190 | |
445b3f51 |
191 | # test lexicals and globals |
192 | { |
193 | my $this = "ok"; |
194 | our $that = 7; |
195 | format LEX = |
196 | @<<@| |
197 | $this,$that |
198 | . |
199 | open(LEX, ">&STDOUT") or die; |
200 | write LEX; |
201 | $that = 8; |
202 | write LEX; |
fdc7a9f2 |
203 | close LEX; |
445b3f51 |
204 | } |
c2e66d9e |
205 | # LEX_INTERPNORMAL test |
206 | my %e = ( a => 1 ); |
207 | format OUT4 = |
208 | @<<<<<< |
209 | "$e{a}" |
210 | . |
211 | open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; |
212 | write (OUT4); |
213 | close OUT4; |
214 | if (`$CAT Op_write.tmp` eq "1\n") { |
215 | print "ok 9\n"; |
784707d5 |
216 | 1 while unlink "Op_write.tmp"; |
c2e66d9e |
217 | } |
218 | else { |
219 | print "not ok 9\n"; |
220 | } |
784707d5 |
221 | |
222 | eval <<'EOFORMAT'; |
223 | format OUT10 = |
224 | @####.## @0###.## |
225 | $test1, $test1 |
226 | . |
227 | EOFORMAT |
228 | |
229 | open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
230 | |
231 | $test1 = 12.95; |
232 | write(OUT10); |
233 | close OUT10; |
234 | |
235 | $right = " 12.95 00012.95\n"; |
236 | if (`$CAT Op_write.tmp` eq $right) |
237 | { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; } |
238 | else |
239 | { print "not ok 10\n"; } |
240 | |
241 | eval <<'EOFORMAT'; |
242 | format OUT11 = |
243 | @0###.## |
244 | $test1 |
245 | @ 0# |
246 | $test1 |
247 | @0 # |
248 | $test1 |
249 | . |
250 | EOFORMAT |
251 | |
252 | open(OUT11, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
253 | |
254 | $test1 = 12.95; |
255 | write(OUT11); |
256 | close OUT11; |
257 | |
258 | $right = |
259 | "00012.95 |
260 | 1 0# |
261 | 10 #\n"; |
262 | if (`$CAT Op_write.tmp` eq $right) |
263 | { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; } |
264 | else |
265 | { print "not ok 11\n"; } |