This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Twisted format testing, from Merijn.
[perl5.git] / t / op / write.t
CommitLineData
a687059c
LW
1#!./perl
2
784707d5 3print "1..11\n";
a687059c 4
3fe9a6f1
PP
5my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
6
a687059c
LW
7format OUT =
8the quick brown @<<
9$fox
10jumped
11@*
12$multiline
13^<<<<<<<<<
14$foo
15^<<<<<<<<<
16$foo
17^<<<<<<...
18$foo
19now @<<the@>>>> for all@|||||men to come @<<<<
a0d0e21e
LW
20{
21 'i' . 's', "time\n", $good, 'to'
22}
a687059c
LW
23.
24
a0d0e21e 25open(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';
31write(OUT);
32close OUT;
33
34$right =
35"the quick brown fox
36jumped
37forescore
38and
39seven years
40when in
41the course
42of huma...
43now is the time for all good men to come to\n";
44
3fe9a6f1 45if (`$CAT Op_write.tmp` eq $right)
784707d5 46 { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; }
a687059c
LW
47else
48 { print "not ok 1\n"; }
49
748a9306
LW
50$fox = 'wolfishness';
51my $fox = 'foxiness'; # Test a lexical variable.
52
a687059c
LW
53format OUT2 =
54the quick brown @<<
55$fox
56jumped
57@*
58$multiline
59^<<<<<<<<< ~~
60$foo
61now @<<the@>>>> for all@|||||men to come @<<<<
62'i' . 's', "time\n", $good, 'to'
63.
64
a0d0e21e 65open 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';
70write(OUT2);
71close OUT2;
72
73$right =
74"the quick brown fox
75jumped
76forescore
77and
78seven years
79when in
80the course
81of human
82events it
83becomes
84necessary
85now is the time for all good men to come to\n";
86
3fe9a6f1 87if (`$CAT Op_write.tmp` eq $right)
784707d5 88 { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; }
a687059c
LW
89else
90 { print "not ok 2\n"; }
91
0f85fab0
LW
92eval <<'EOFORMAT';
93format OUT2 =
94the brown quick @<<
95$fox
96jumped
97@*
98$multiline
a0d0e21e 99and
0f85fab0
LW
100^<<<<<<<<< ~~
101$foo
102now @<<the@>>>> for all@|||||men to come @<<<<
103'i' . 's', "time\n", $good, 'to'
104.
105EOFORMAT
106
a0d0e21e 107open(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';
113write(OUT2);
114close OUT2;
115
116$right =
117"the brown quick fox
118jumped
119forescore
120and
121seven years
a0d0e21e 122and
0f85fab0
LW
123when in
124the course
125of human
126events it
127becomes
128necessary
129now is the time for all good men to come to\n";
130
3fe9a6f1 131if (`$CAT Op_write.tmp` eq $right)
784707d5 132 { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; }
0f85fab0
LW
133else
134 { print "not ok 3\n"; }
135
55497cff
PP
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
150EOT
151
152$was1 = $was2 = '';
153for (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}
165print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
166print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
167
7056ecde
URCI
168$^A = '';
169
170# more test
171
172format OUT3 =
173^<<<<<<...
174$foo
175.
176
177open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
178
179$foo = 'fit ';
180write(OUT3);
181close OUT3;
182
183$right =
184"fit\n";
185
186if (`$CAT Op_write.tmp` eq $right)
784707d5 187 { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; }
7056ecde
URCI
188else
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
206my %e = ( a => 1 );
207format OUT4 =
208@<<<<<<
209"$e{a}"
210.
211open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp";
212write (OUT4);
213close OUT4;
214if (`$CAT Op_write.tmp` eq "1\n") {
215 print "ok 9\n";
784707d5 216 1 while unlink "Op_write.tmp";
c2e66d9e
GS
217 }
218else {
219 print "not ok 9\n";
220 }
784707d5
JP
221
222eval <<'EOFORMAT';
223format OUT10 =
224@####.## @0###.##
225$test1, $test1
226.
227EOFORMAT
228
229open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp";
230
231$test1 = 12.95;
232write(OUT10);
233close OUT10;
234
235$right = " 12.95 00012.95\n";
236if (`$CAT Op_write.tmp` eq $right)
237 { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; }
238else
239 { print "not ok 10\n"; }
240
241eval <<'EOFORMAT';
242format OUT11 =
243@0###.##
244$test1
245@ 0#
246$test1
247@0 #
248$test1
249.
250EOFORMAT
251
252open(OUT11, '>Op_write.tmp') || die "Can't create Op_write.tmp";
253
254$test1 = 12.95;
255write(OUT11);
256close OUT11;
257
258$right =
259"00012.95
2601 0#
26110 #\n";
262if (`$CAT Op_write.tmp` eq $right)
263 { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; }
264else
265 { print "not ok 11\n"; }