diff options
author | schmonz <schmonz@pkgsrc.org> | 2013-01-20 02:57:36 +0000 |
---|---|---|
committer | schmonz <schmonz@pkgsrc.org> | 2013-01-20 02:57:36 +0000 |
commit | 44d2b4941706e4c13498b1974b4576c7003dab89 (patch) | |
tree | 4a761f8762e6c20280720b3a7e572d3725a2cc2f /pkgtools | |
parent | aa896340317621efeed0a38967f6b51358425bed (diff) | |
download | pkgsrc-44d2b4941706e4c13498b1974b4576c7003dab89.tar.gz |
pkglint(1) determines its list of basic variable types by grepping
itself for certain if/elsif conditions. This combination of cleverness
and large conditional block should be replaced with simple,
table-driven code. But first we have to get the functionality under
test, which I've begun to do here.
Initialize a package global with the contents of $0, and override
it in test (otherwise self-grepping breaks because $0 is the test
script). Extract the dirty Test::Trap details to test_unit(). Test
main() for a few common values of @ARGV. Notice the aforementioned
cleverness because it broke an expected success, and fix it just
enough to test get_vartypes_basictypes() for a couple expected
types.
No functional change intended. I've manually tested the small changes
to pkglint.pl and have also verified that a couple packages lint
the same as before.
Diffstat (limited to 'pkgtools')
-rw-r--r-- | pkgtools/pkglint/files/pkglint.pl | 10 | ||||
-rw-r--r-- | pkgtools/pkglint/files/pkglint.t | 52 |
2 files changed, 49 insertions, 13 deletions
diff --git a/pkgtools/pkglint/files/pkglint.pl b/pkgtools/pkglint/files/pkglint.pl index a487c69e8e5..e8e419a3889 100644 --- a/pkgtools/pkglint/files/pkglint.pl +++ b/pkgtools/pkglint/files/pkglint.pl @@ -1,5 +1,5 @@ #! @PERL@ -# $NetBSD: pkglint.pl,v 1.848 2013/01/19 22:51:11 schmonz Exp $ +# $NetBSD: pkglint.pl,v 1.849 2013/01/20 02:57:36 schmonz Exp $ # # pkglint - static analyzer and checker for pkgsrc packages @@ -1326,6 +1326,8 @@ my (@options) = ( } ], ); +our $program = $0; + # # Commonly used regular expressions. # @@ -1454,7 +1456,7 @@ my @todo_items; # The list of directory entries that still need sub help($$$) { my ($out, $exitval, $show_all) = @_; - my ($prog) = (basename($0)); + my ($prog) = (basename($program, '.pl')); print $out ("usage: $prog [options] [package_directory]\n\n"); my (@option_table) = (); @@ -1684,9 +1686,9 @@ sub get_vartypes_basictypes() { return $get_vartypes_basictypes_result; } - my $lines = load_file($0); + my $lines = load_file($program); my $types = {}; - assert($lines, "Couldn't load pkglint.pl from $0"); + assert($lines, "Couldn't load pkglint.pl from $program"); foreach my $line (@$lines) { if ($line->text =~ m"^\s+\} elsif \(\$type eq \"(\w+)\"\) \{$") { $types->{$1} = 1; diff --git a/pkgtools/pkglint/files/pkglint.t b/pkgtools/pkglint/files/pkglint.t index 54f7656d537..9bf22abd82c 100644 --- a/pkgtools/pkglint/files/pkglint.t +++ b/pkgtools/pkglint/files/pkglint.t @@ -1,27 +1,61 @@ #! @PERL@ -# $NetBSD: pkglint.t,v 1.1 2013/01/19 22:51:11 schmonz Exp $ +# $NetBSD: pkglint.t,v 1.2 2013/01/20 02:57:37 schmonz Exp $ # +require 'pkglint.pl'; # so we can test its internals +$main::program = 'pkglint.pl'; # because it self-greps for vartypes + package PkgLint::Test; # pkglint.pl uses 'main', so we mustn't -use Test::More tests => 3; +use Test::More tests => 17; use Test::Trap; use warnings; use strict; -require 'pkglint.pl'; # so we can test its internals +sub test_unit { + my ($unit, $params, $exitcode, $stdout_re, $stderr_re) = @_; + + my @results = trap { $unit->(@{$params}) }; + + if (defined $exitcode) { + is($trap->exit, $exitcode, qq{exits $exitcode}); + } else { + is($trap->exit, undef, q{doesn't exit}); + } + like($trap->stdout, qr/$stdout_re/, qq{stdout matches $stdout_re}); + like($trap->stderr, qr/$stderr_re/, qq{stderr matches $stderr_re}); + + return @results; +} -sub test_main() { +sub test_get_vartypes_basictypes { + my $unit = \&main::get_vartypes_basictypes; + + my @results = test_unit($unit, undef, undef, '^$', '^$'); + my %types = %{$results[0]}; + is($types{YesNo_Indirectly}, 1, q{a couple expected types are here}); + is($types{BuildlinkDepmethod}, 1, q{a couple expected types are here}); +} + +sub test_main { my $unit = \&main::main; - my @r = trap { $unit->() }; - is($trap->exit, 1, q{exit code was 1}); - like($trap->stdout, qr/^ERROR:.+how to check/, q{message on stdout}); - is($trap->stderr, '', q{nothing on stderr}); + @ARGV = ('-h'); + test_unit($unit, undef, 0, '^usage: pkglint ', '^$'); + + @ARGV = (); + test_unit($unit, undef, 1, '^ERROR:.+how to check', '^$'); + + @ARGV = ('.'); + test_unit($unit, undef, 1, '^ERROR:.+how to check', '^$'); + + @ARGV = ('..'); + test_unit($unit, undef, 1, '^ERROR:.+LICENSE', '^$'); } -sub main() { +sub main { + test_get_vartypes_basictypes(); test_main(); } |