aboutsummaryrefslogtreecommitdiffstats
path: root/t/002goodperl.t
diff options
context:
space:
mode:
Diffstat (limited to 't/002goodperl.t')
-rw-r--r--t/002goodperl.t71
1 files changed, 39 insertions, 32 deletions
diff --git a/t/002goodperl.t b/t/002goodperl.t
index 02a57bea1..e95870d70 100644
--- a/t/002goodperl.t
+++ b/t/002goodperl.t
@@ -10,15 +10,19 @@
#Bugzilla Test 2#
####GoodPerl#####
+use 5.10.1;
use strict;
+use warnings;
use lib 't';
use Support::Files;
-use Test::More tests => (scalar(@Support::Files::testitems) * 4);
+use Test::More tests => (scalar(@Support::Files::testitems)
+ + scalar(@Support::Files::test_files)) * 5;
-my @testitems = @Support::Files::testitems; # get the files to test.
+my @testitems = (@Support::Files::test_files, @Support::Files::testitems);
+my @require_taint = qw(email_in.pl importxml.pl mod_perl.pl whine.pl);
foreach my $file (@testitems) {
$file =~ s/\s.*$//; # nuke everything after the first space (#comment)
@@ -38,23 +42,33 @@ foreach my $file (@testitems) {
my $flags;
if (!defined $ext || $ext eq "pl") {
# standalone programs aren't taint checked yet
- $flags = "w";
+ if (grep { $file eq $_ } @require_taint) {
+ $flags = 'T';
+ }
+ else {
+ $flags = '';
+ }
} elsif ($ext eq "pm") {
ok(0, "$file is a module, but has a shebang");
next;
} elsif ($ext eq "cgi") {
# cgi files must be taint checked
- $flags = "wT";
+ $flags = 'T';
} else {
ok(0, "$file has shebang but unknown extension");
next;
}
- if ($file_line1 =~ m#^\#\!/usr/bin/perl\s#) {
- if ($file_line1 =~ m#\s-$flags#) {
- ok(1,"$file uses standard perl location and -$flags");
- } else {
- ok(0,"$file is MISSING -$flags --WARNING");
+ if ($file_line1 =~ m#^\#\!/usr/bin/perl(?:\s-(\w+))?$#) {
+ my $file_flags = $1 || '';
+ if ($flags eq $file_flags) {
+ ok(1, "$file uses standard perl location" . ($flags ? " and -$flags flag" : ""));
+ }
+ elsif ($flags) {
+ ok(0, "$file is MISSING -$flags flag --WARNING");
+ }
+ else {
+ ok(0, "$file has unexpected -$file_flags flag --WARNING");
}
} else {
ok(0,"$file uses non-standard perl location");
@@ -63,7 +77,10 @@ foreach my $file (@testitems) {
}
foreach my $file (@testitems) {
+ my $found_use_perl = 0;
my $found_use_strict = 0;
+ my $found_use_warnings = 0;
+
$file =~ s/\s.*$//; # nuke everything after the first space (#comment)
next if (!$file); # skip null entries
if (! open (FILE, $file)) {
@@ -71,38 +88,28 @@ foreach my $file (@testitems) {
next;
}
while (my $file_line = <FILE>) {
- if ($file_line =~ m/^\s*use strict/) {
- $found_use_strict = 1;
- last;
- }
+ $found_use_perl = 1 if $file_line =~ m/^\s*use 5.10.1/;
+ $found_use_strict = 1 if $file_line =~ m/^\s*use strict/;
+ $found_use_warnings = 1 if $file_line =~ m/^\s*use warnings/;
+ last if ($found_use_perl && $found_use_strict && $found_use_warnings);
}
close (FILE);
+ if ($found_use_perl) {
+ ok(1,"$file requires Perl 5.10.1");
+ } else {
+ ok(0,"$file DOES NOT require Perl 5.10.1 --WARNING");
+ }
+
if ($found_use_strict) {
ok(1,"$file uses strict");
} else {
ok(0,"$file DOES NOT use strict --WARNING");
}
-}
-foreach my $file (@testitems) {
- my $found_use_feature = 0;
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- if (! open (FILE, $file)) {
- ok(0,"could not open $file --WARNING");
- next;
- }
- while (my $file_line = <FILE>) {
- if ($file_line =~ m/^\s*use 5.10.1/) {
- $found_use_feature = 1;
- last;
- }
- }
- close (FILE);
- if ($found_use_feature) {
- ok(1,"$file requires Perl 5.10.1");
+ if ($found_use_warnings) {
+ ok(1,"$file uses warnings");
} else {
- ok(0,"$file DOES NOT require Perl 5.10.1 --WARNING");
+ ok(0,"$file DOES NOT use warnings --WARNING");
}
}