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.

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();
 }