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
|
#!/usr/bin/perl -w
# 0-no-debug-left-on.t -- check no Smart::Comments left on
# Copyright 2011, 2012 Kevin Ryde
# 0-no-debug-left-on.t is shared by several distributions.
#
# 0-no-debug-left-on.t is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# 0-no-debug-left-on.t is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see <http://www.gnu.org/licenses/>.
# cf Test::NoSmartComments which uses Module::ScanDeps.
require 5;
use strict;
Test::NoDebugLeftOn->Test_More(verbose => 0);
exit 0;
package Test::NoDebugLeftOn;
use strict;
use ExtUtils::Manifest;
sub Test_More {
my ($class, %options) = @_;
require Test::More;
Test::More::plan (tests => 1);
Test::More::ok ($class->check (diag => \&Test::More::diag,
%options));
1;
}
sub check {
my ($class, %options) = @_;
my $diag = $options{'diag'};
if (! -e 'Makefile.PL') {
&$diag ('skip, no Makefile.PL so not ExtUtils::MakeMaker');
return 1;
}
my $href = ExtUtils::Manifest::maniread();
my @files = keys %$href;
my $good = 1;
my @perl_files = grep {m{
^lib/
|^(lib|examples|x?t)/.*\.(p[lm]|t)$
|^Makefile.PL$
|^[^/]+$
}x
} @files;
my $filename;
foreach $filename (@perl_files) {
if ($options{'verbose'}) {
&$diag ("perl file ",$filename);
}
if (! open FH, "< $filename") {
&$diag ("Oops, cannot open $filename: $!");
$good = 0;
next;
}
while (<FH>) {
if (/^__END__/) {
last;
}
# only a DEBUG=> non-zero number is bad, so an expression can copy a
# debug from another package
if (/(DEBUG\s*=>\s*[1-9][0-9]*)/
|| /^[ \t]*((use|no) (Smart|Devel)::Comments)/
|| /^[ \t]*(use lib\b.*devel.*)/
) {
print STDERR "\n$filename:$.: leftover: $_\n";
$good = 0;
}
}
if (! close FH) {
&$diag ("Oops, error closing $filename: $!");
$good = 0;
next;
}
}
my @C_files = grep {m{
# toplevel or lib .c and .xs files
^[^/]*\.([ch]|xs)$
|^(lib|examples|x?t)/.*\.([ch]|xs)$
}x
} @files;
foreach $filename (@C_files) {
if ($options{'verbose'}) {
&$diag ("C/XS file ",$filename);
}
if (! open FH, "< $filename") {
&$diag ("Oops, cannot open $filename: $!");
$good = 0;
next;
}
while (<FH>) {
if (/^#\s*define\s+DEBUG\s+[1-9]/
) {
print STDERR "\n$filename:$.: leftover: $_\n";
$good = 0;
}
}
if (! close FH) {
&$diag ("Oops, error closing $filename: $!");
$good = 0;
next;
}
}
&$diag ("checked ",scalar(@perl_files)," perl files, ",
scalar(@C_files)," C/XS files\n");
return $good;
}
|
