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
|
#!/usr/bin/perl -w
##
## Tests errors
## by creating files with incorrect syntax or no "use strict;"
## and run Test::Strict under an external perl interpreter.
## The output is parsed to check result.
##
use strict;
BEGIN {
if ($^O =~ /win32/i) {
require Test::More;
Test::More->import(
skip_all => "Windows does not allow two processes to access the same file."
);
}
}
use Test::More tests => 10;
use File::Temp qw( tempdir tempfile );
my $perl = $^X || 'perl';
my $inc = join(' -I ', @INC) || '';
$inc = "-I $inc" if $inc;
test1();
test2();
test3();
test4();
exit;
sub test1 {
my $dir = make_bad_file();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc -MTest::Strict -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/^ok 1 - Syntax check /m, "Syntax ok" );
like( $content, qr/not ok 2 - use strict /, "Does not have use strict" );
}
sub test2 {
my $dir = make_another_bad_file();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc -MTest::Strict -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/not ok 1 \- Syntax check /, "Syntax error" );
like( $content, qr/^ok 2 \- use strict /m, "Does have use strict" );
}
sub test3 {
my $file = make_bad_warning();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc -e "use Test::Strict no_plan =>1; warnings_ok( '$file' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/not ok 1 \- use warnings /, "Does not have use warnings" );
}
sub test4 {
my $test_file = make_warning_files();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc $test_file 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/not ok \d+ \- use warnings/, "Does not have use warnings" );
}
sub make_bad_file {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
print "Hello world without use strict";
# use strict;
=over
use strict;
=back
=for
use strict;
=end
=pod
use strict;
=cut
DUMMY
return $tmpdir;
}
sub make_another_bad_file {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
=pod
blah
=cut
# a comment
undef;use strict ; foobarbaz + 1; # another comment
DUMMY
return $tmpdir;
}
sub make_bad_warning {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
print "Hello world without use warnings";
# use warnings;
=over
use warnings;
=back
=for
use warnings;
=end
=pod
use warnings;
=cut
DUMMY
return $filename;
}
sub make_warning_files {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh1, $filename1) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh1 <<'DUMMY';
use strict;
use warnings::register ;
print "Hello world";
DUMMY
my ($fh2, $filename2) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh2 <<'DUMMY';
#!/usr/bin/perl -vw
use strict;
print "Hello world";
DUMMY
my ($fh3, $filename3) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh3 <<'DUMMY';
use strict;
local $^W = 1;
print "Hello world";
DUMMY
my ($fh4, $filename4) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh4 <<"TEST";
use strict;
use warnings;
use Test::Strict 'no_plan';
local \$Test::Strict::TEST_WARNINGS = 1;
all_perl_files_ok( '$tmpdir' );
TEST
return $filename4;
}
|
