Commit | Line | Data |
---|---|---|
a687059c LW |
1 | #!./perl |
2 | ||
784707d5 | 3 | print "1..11\n"; |
a687059c | 4 | |
3fe9a6f1 | 5 | my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; |
6 | ||
a687059c LW |
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 LW |
20 | { |
21 | 'i' . 's', "time\n", $good, 'to' | |
22 | } | |
a687059c LW |
23 | . |
24 | ||
a0d0e21e | 25 | open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp"; |
a687059c LW |
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 LW |
47 | else |
48 | { print "not ok 1\n"; } | |
49 | ||
748a9306 LW |
50 | $fox = 'wolfishness'; |
51 | my $fox = 'foxiness'; # Test a lexical variable. | |
52 | ||
a687059c LW |
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 LW |
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 LW |
89 | else |
90 | { print "not ok 2\n"; } | |
91 | ||
0f85fab0 LW |
92 | eval <<'EOFORMAT'; |
93 | format OUT2 = | |
94 | the brown quick @<< | |
95 | $fox | |
96 | jumped | |
97 | @* | |
98 | $multiline | |
a0d0e21e | 99 | and |
0f85fab0 LW |
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 LW |
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 LW |
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 LW |
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 KM |
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 KM |
188 | else |
189 | { print "not ok 6\n"; } | |
190 | ||
445b3f51 GS |
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 GS |
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 GS |
217 | } |
218 | else { | |
219 | print "not ok 9\n"; | |
220 | } | |
784707d5 JP |
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"; } |