diff options
Diffstat (limited to 't/002goodperl.t')
-rw-r--r-- | t/002goodperl.t | 113 |
1 files changed, 113 insertions, 0 deletions
diff --git a/t/002goodperl.t b/t/002goodperl.t new file mode 100644 index 0000000..e691b39 --- /dev/null +++ b/t/002goodperl.t @@ -0,0 +1,113 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This Source Code Form is "Incompatible With Secondary Licenses", as +# defined by the Mozilla Public License, v. 2.0. + + +################# +#Bugzilla Test 2# +####GoodPerl##### + +use strict; + +use lib 't'; + +use Support::Files; + +use Test::More tests => (scalar(@Support::Files::testitems) * 3); + +my @testitems = @Support::Files::testitems; # get the files to test. + +foreach my $file (@testitems) { + $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"); + } + my $file_line1 = <FILE>; + close (FILE); + + $file =~ m/.*\.(.*)/; + my $ext = $1; + + if ($file_line1 !~ m/^#\!/) { + ok(1,"$file does not have a shebang"); + } else { + my $flags; + if (!defined $ext || $ext eq "pl") { + # standalone programs aren't taint checked yet + $flags = "w"; + } 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"; + } 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"); + } + } else { + ok(0,"$file uses non-standard perl location"); + } + } +} + +foreach my $file (@testitems) { + my $found_use_strict = 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 strict/) { + $found_use_strict = 1; + last; + } + } + close (FILE); + if ($found_use_strict) { + ok(1,"$file uses strict"); + } else { + ok(0,"$file DOES NOT use strict --WARNING"); + } +} + +# Check to see that all error messages use tags (for l10n reasons.) +foreach my $file (@testitems) { + $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; + } + my $lineno = 0; + my $error = 0; + + while (!$error && (my $file_line = <FILE>)) { + $lineno++; + if ($file_line =~ /Throw.*Error\("(.*?)"/) { + if ($1 =~ /\s/) { + ok(0,"$file has a Throw*Error call on line $lineno + which doesn't use a tag --ERROR"); + $error = 1; + } + } + } + + ok(1,"$file uses Throw*Error calls correctly") if !$error; + + close(FILE); +} +exit 0; |