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
|
# 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;
|
