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
|
#!./perl
use strict;
# test that perlbug generates somewhat sane reports, but don't
# actually send them
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
require './test.pl';
# lifted from perl5db.t
my $extracted_program = '../utils/perlbug'; # unix, nt, ...
if ($^O eq 'VMS') { $extracted_program = '[-.utils]perlbug.com'; }
if (!(-e $extracted_program)) {
print "1..0 # Skip: $extracted_program was not built\n";
exit 0;
}
my $result;
my $testreport = 'test.rep';
unlink $testreport;
sub _slurp {
my $file = shift;
ok(-f $file, "saved report $file exists");
open(F, '<', $file) or return undef;
local $/;
my $ret = <F>;
close F;
$ret;
}
sub _dump {
my $file = shift;
my $contents = shift;
open(F, '>', $file) or return;
print F $contents;
close F;
return 1;
}
plan(25);
# check -d
$result = runperl( progfile => $extracted_program,
args => ['-d'] );
like($result, qr/Site configuration information/,
'config information dumped with -d');
# check -v
$result = runperl( progfile => $extracted_program,
args => ['-d', '-v'] );
like($result, qr/Complete configuration data/,
'full config information dumped with -d -v');
# check that we need -t
$result = runperl( progfile => $extracted_program,
stderr => 1, # perlbug dies with "\n";
stdin => undef);
like($result, qr/Please use perlbug interactively./,
'checks for terminal in non-test mode');
# test -okay (mostly noninteractive)
$result = runperl( progfile => $extracted_program,
args => ['-okay', '-F', $testreport] );
like($result, qr/Message saved/, 'build report saved');
like(_slurp($testreport), qr/Perl reported to build OK on this system/,
'build report looks sane');
unlink $testreport;
# test -nokay (a bit more interactive)
$result = runperl( progfile => $extracted_program,
stdin => 'f', # save to File
args => ['-t',
'-nokay',
'-e', 'file',
'-F', $testreport] );
like($result, qr/Message saved/, 'build failure report saved');
like(_slurp($testreport), qr/This is a build failure report for perl/,
'build failure report looks sane');
unlink $testreport;
# test a regular report
$result = runperl( progfile => $extracted_program,
# no CLI options for these
stdin => "\n" # Module
. "\n" # Category
. "\n" # Severity
. "\n" # Editor
. "f", # save to File
args => ['-t',
# runperl has trouble with whitespace
'-s', "testingperlbug",
'-r', 'username@example.com',
'-c', 'none',
'-b', 'testreportbody',
'-e', 'file',
'-F', $testreport] );
like($result, qr/Message saved/, 'fake bug report saved');
my $contents = _slurp($testreport);
like($contents, qr/Subject: testingperlbug/,
'Subject included in fake bug report');
like($contents, qr/testreportbody/, 'body included in fake bug report');
unlink $testreport;
# test wrapping of long lines
my $body = 'body.txt';
unlink $body;
my $A = 'A'x9;
ok(_dump($body, ("$A "x120)), 'wrote 1200-char body to file');
my $attachment = 'attached.txt';
unlink $attachment;
my $B = 'B'x9;
ok(_dump($attachment, ("$B "x120)), 'wrote 1200-char attachment to file');
$result = runperl( progfile => $extracted_program,
stdin => "testing perlbug\n" # Subject
. "\n" # Module
. "\n" # Category
. "\n" # Severity
. "f", # save to File
args => ['-t',
'-r', 'username@example.com',
'-c', 'none',
'-f', $body,
'-p', $attachment,
'-e', 'file',
'-F', $testreport] );
like($result, qr/Message saved/, 'fake bug report saved');
my $contents = _slurp($testreport);
unlink $testreport, $body, $attachment;
like($contents, qr/Subject: testing perlbug/,
'Subject included in fake bug report');
like($contents, qr/$A/, 'body included in fake bug report');
like($contents, qr/$B/, 'attachment included in fake bug report');
my $maxlen1 = 0; # body
my $maxlen2 = 0; # attachment
for (split(/\n/, $contents)) {
my $len = length;
$maxlen1 = $len if $len > $maxlen1 and !/$B/;
$maxlen2 = $len if $len > $maxlen2 and /$B/;
}
ok($maxlen1 < 1000, "[perl #128020] long body lines are wrapped: maxlen $maxlen1");
ok($maxlen2 > 1000, "long attachment lines are not wrapped: maxlen $maxlen2");
$result = runperl( progfile => $extracted_program, stderr => 1, args => ['-o'] ); # Invalid option
like($result, qr/^\s*This program is designed/, "No leading error messages with help from invalid arg.");
$result = runperl( progfile => $extracted_program, stderr => 1, args => ['--help'] ); # Invalid option
like($result, qr/^\s*perlbug version \d+\.\d+\n+This program is designed/, "No leading error messages with help from --help and version is displayed.");
$result = runperl( progfile => $extracted_program, stderr => 1, args => ['--version'] ); # Invalid option
like($result, qr/^perlbug version \d+\.\d+\n$/, "No leading error messages with --version");
#print $result;
|