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
|
#!perl -w
#
# Test that every perl script accepts and processes each of the options
# documented in its POD.
#
# Cute test :)
#
# Steve
# --
#
use strict;
use File::Find;
use Test::More;
#
# Test each file
#
foreach my $file ( sort( glob "./bin/*-*" ) )
{
# Skip emacs and CVS backups
next if $file =~ /~$/;
testFile( $file );
}
done_testing();
#
# Check that the given file implements all the option processing it
# is supposed to.
#
#
sub testFile
{
my ($file ) = (@_);
is( -e $file, 1, "File exists: $file" );
is( -x $file, 1, "File is executable" );
#
# Run the file with "--help" and capture the output.
#
my $output = `perl -Ilib $file --help`;
#
# Parse out the options we accept
#
my @documented = ();
foreach my $line ( split( /\n/, $output ) )
{
if ( $line =~ /[ \t]*--(?:\(no\))?([a-z-_]+)/ )
{
push @documented, $1 unless( $line =~ /NOP/i );
}
}
#
# Test we discovered some documented options.
#
ok( $#documented > 1, "We found some options documented in $file." );
#
# Now read the input file so that we can see if these advertised
# options are actually used.
#
open( IN, "<", $file ) or die "Failed to open file for reading $file - $!";
my @LINES = <IN>;
close( IN );
#
# Options accepted
#
my %accepted;
#
# Do minimal parsing to find the options we process with
# Getopt::Long;
#
my $complete = join( "\n", @LINES );
if ( $complete =~ /GetOptions\(([^\)]+)\)/mi )
{
#
# Multi-line text which should have all the options we've
# invoked GetOptions with.
#
my $opt = $1;
#
# Process each one.
#
foreach my $o ( split( /\n/, $opt ) )
{
#print "O: $o ";
#
# Strip trailing comments.
#
if ( $o =~ /([^#]+)#/ )
{
$o = $1;
}
#print " - strip comments : $o ";
#
# Remove "" or '' around it.
#
if ( $o =~ /(["'])([^"']+)\1/ )
{
$o = $2;
}
#print " - remove quotes : $o ";
#
# Discard anything after "=", ":", or " "
#
if ( $o =~ /(.*)[ \t=:]+(.*)/ )
{
$o = $1;
}
#print " - remove negation : $o ";
#
# Discard any "!" at the end
#
$o =~ s/!//;
#print " - remove = : $o ";
#
# Now avoid blank lines.
#
next if ( $o =~ /^[ \t]*$/ );
#
# Now split at pipe
#
foreach my $osplit (split(/\|/, $o)) {
#
# Phew. Now we're done.
#
# This option '$osplit' is something we call GetOptions with.
#
$accepted{$osplit} = 1;
}
}
}
#
# Now we want to make sure that each documented option is
# present in the list of options we pass to getopt.
#
foreach my $argument ( @documented )
{
is( $accepted{$argument}, 1, "Option '--$argument' accepted: $file" );
}
}
|
