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
|
#!/usr/bin/perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
print "1..33\n";
use strict; # Amazed that this hackery can be made strict ...
# Just a complete test for format, including top-, left- and bottom marging
# and format detection through glob entries
$= = 7; # Page length
my $ps = $^L; $^L = ""; # Catch the page separator
my $tm = 1; # Top margin (empty lines before first output)
my $bm = 2; # Bottom marging (empty lines between last text and footer)
my $lm = 4; # Left margin (indent in spaces)
if ($lm > 0 and !open STDOUT, "|-") { # Left margin (in this test ALWAYS set)
my $i = 1;
my $s = " " x $lm;
while (<STDIN>) {
s/^/$s/;
print + ($_ eq <DATA> ? "" : "not "), "ok ", $i++, "\n";
}
close STDIN;
print + (<DATA>?"not ":""), "ok ", $i++, "\n";
close STDOUT;
exit;
}
$tm = "\n" x $tm;
$= -= $bm + 1; # count one for the trailing "----"
my $lastmin = 0;
my @E;
sub wryte
{
$lastmin = $-;
write;
} # wryte;
sub footer
{
$% == 1 and return "";
$lastmin < $= and print "\n" x $lastmin;
print "\n" x $bm, "----\n", $ps;
$lastmin = $-;
"";
} # footer
# Yes, this is sick ;-)
format TOP =
@* ~
@{[footer]}
@* ~
$tm
.
format EmptyTOP =
.
format ENTRY =
@ @<<<<~~
@{(shift @E)||["",""]}
.
format EOR =
- -----
.
sub has_format ($)
{
my $fmt = shift;
exists $::{$fmt} or return 0;
$^O eq "MSWin32" or return defined *{$::{$fmt}}{FORMAT};
open my $null, "> /dev/null" or die;
my $fh = select $null;
local $~ = $fmt;
eval "write";
select $fh;
$@?0:1;
} # has_format
$^ = has_format ("TOP") ? "TOP" : "EmptyTOP";
has_format ("ENTRY") or die "No format defined for ENTRY";
foreach my $e ( [ map { [ $_, "Test$_" ] } 1 .. 7 ],
[ map { [ $_, "${_}tseT" ] } 1 .. 5 ]) {
@E = @$e;
local $~ = "ENTRY";
wryte;
has_format ("EOR") or next;
local $~ = "EOR";
wryte;
}
if (has_format ("EOF")) {
local $~ = "EOF";
wryte;
}
close STDOUT;
__END__
1 Test1
2 Test2
3 Test3
----
4 Test4
5 Test5
6 Test6
----
7 Test7
- -----
----
1 1tseT
2 2tseT
3 3tseT
----
4 4tseT
5 5tseT
- -----
|
