1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
#!./perl
# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
print "1..5\n";
my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
format OUT =
the quick brown @<<
$fox
jumped
@*
$multiline
^<<<<<<<<<
$foo
^<<<<<<<<<
$foo
^<<<<<<...
$foo
now @<<the@>>>> for all@|||||men to come @<<<<
{
'i' . 's', "time\n", $good, 'to'
}
.
open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp";
$fox = 'foxiness';
$good = 'good';
$multiline = "forescore\nand\nseven years\n";
$foo = 'when in the course of human events it becomes necessary';
write(OUT);
close OUT;
$right =
"the quick brown fox
jumped
forescore
and
seven years
when in
the course
of huma...
now is the time for all good men to come to\n";
if (`$CAT Op_write.tmp` eq $right)
{ print "ok 1\n"; unlink 'Op_write.tmp'; }
else
{ print "not ok 1\n"; }
$fox = 'wolfishness';
my $fox = 'foxiness'; # Test a lexical variable.
format OUT2 =
the quick brown @<<
$fox
jumped
@*
$multiline
^<<<<<<<<< ~~
$foo
now @<<the@>>>> for all@|||||men to come @<<<<
'i' . 's', "time\n", $good, 'to'
.
open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp";
$good = 'good';
$multiline = "forescore\nand\nseven years\n";
$foo = 'when in the course of human events it becomes necessary';
write(OUT2);
close OUT2;
$right =
"the quick brown fox
jumped
forescore
and
seven years
when in
the course
of human
events it
becomes
necessary
now is the time for all good men to come to\n";
if (`$CAT Op_write.tmp` eq $right)
{ print "ok 2\n"; unlink 'Op_write.tmp'; }
else
{ print "not ok 2\n"; }
eval <<'EOFORMAT';
format OUT2 =
the brown quick @<<
$fox
jumped
@*
$multiline
and
^<<<<<<<<< ~~
$foo
now @<<the@>>>> for all@|||||men to come @<<<<
'i' . 's', "time\n", $good, 'to'
.
EOFORMAT
open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp";
$fox = 'foxiness';
$good = 'good';
$multiline = "forescore\nand\nseven years\n";
$foo = 'when in the course of human events it becomes necessary';
write(OUT2);
close OUT2;
$right =
"the brown quick fox
jumped
forescore
and
seven years
and
when in
the course
of human
events it
becomes
necessary
now is the time for all good men to come to\n";
if (`$CAT Op_write.tmp` eq $right)
{ print "ok 3\n"; unlink 'Op_write.tmp'; }
else
{ print "not ok 3\n"; }
# formline tests
$mustbe = <<EOT;
@ a
@> ab
@>> abc
@>>> abc
@>>>> abc
@>>>>> abc
@>>>>>> abc
@>>>>>>> abc
@>>>>>>>> abc
@>>>>>>>>> abc
@>>>>>>>>>> abc
EOT
$was1 = $was2 = '';
for (0..10) {
# lexical picture
$^A = '';
my $format1 = '@' . '>' x $_;
formline $format1, 'abc';
$was1 .= "$format1 $^A\n";
# global
$^A = '';
local $format2 = '@' . '>' x $_;
formline $format2, 'abc';
$was2 .= "$format2 $^A\n";
}
print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
|
