From 3e23961f27b7b4a6a407cfe87d06c8f58ccabe08 Mon Sep 17 00:00:00 2001 From: schmonz Date: Tue, 26 Mar 2013 15:05:27 +0000 Subject: Sanity-check pkglint on some reference packages. --- pkgtools/pkglint/files/pkglint.t | 91 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 86 insertions(+), 5 deletions(-) (limited to 'pkgtools') diff --git a/pkgtools/pkglint/files/pkglint.t b/pkgtools/pkglint/files/pkglint.t index a6c8b1e0073..a02d5efeb28 100644 --- a/pkgtools/pkglint/files/pkglint.t +++ b/pkgtools/pkglint/files/pkglint.t @@ -1,5 +1,5 @@ #! @PERL@ -# $NetBSD: pkglint.t,v 1.4 2013/03/26 15:04:30 schmonz Exp $ +# $NetBSD: pkglint.t,v 1.5 2013/03/26 15:05:27 schmonz Exp $ # require 'pkglint.pl'; # so we can test its internals @@ -7,9 +7,15 @@ $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 => 28; +use Test::More tests => 37; use Test::Trap; +use Config; +use File::Basename; +use IO::File; +use IPC::Open3; +use Symbol qw(gensym); + use warnings; use strict; @@ -18,19 +24,47 @@ sub test_unit { $stdout_re ||= '^$'; $stderr_re ||= '^$'; - my @results = trap { $unit->(@{$params}) }; + 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}); + like($trap->stdout, qr/$stdout_re/sm, qq{stdout matches $stdout_re}); + like($trap->stderr, qr/$stderr_re/sm, qq{stderr matches $stderr_re}); return @results; } +sub test_program { + my ($command, $params, $exitcode, $stdout_re, $stderr_re) = @_; + $stdout_re ||= '^$'; + $stderr_re ||= '^$'; + + my $stdout = ''; + my $stderr = ''; + local *CATCHERR = IO::File->new_tmpfile; + my $pid = open3(gensym(), \*CATCHOUT, ">&CATCHERR", $command, @$params); + while (my $l = ) { + $stdout .= $l; + } + waitpid($pid, 0); + my $ret = $? >> 8; + seek CATCHERR, 0, 0; + while (my $l = ) { + $stderr .= $l; + } + + if (defined $exitcode) { + is($ret, $exitcode, qq{exits $exitcode}); + } + like($stdout, qr/$stdout_re/sm, qq{stdout matches $stdout_re}); + like($stderr, qr/$stderr_re/sm, qq{stderr matches $stderr_re}); + + # return @results; +} + sub test_get_vartypes_basictypes { my $unit = \&main::get_vartypes_basictypes; @@ -87,11 +121,58 @@ sub test_main { test_unit($unit, undef, 1, '^ERROR:.+outside a pkgsrc', '^$'); } +sub test_lint_some_reference_packages { + my %reference_packages = ( + 'mail/qmail-run' => { + stdout_re => < undef, + exitcode => 1, + }, + 'mail/qmail' => { + stdout_re => < undef, + exitcode => 1, + }, + 'mail/getmail' => { + stdout_re => < undef, + exitcode => 0, + }, + ); + + my $dirprefix = dirname($0) || '.'; + my $pkglint = "$dirprefix/pkglint.pl"; + my $perl = $Config{perlpath}; + for my $package (keys %reference_packages) { + test_program($perl, [ $pkglint, "../../../$package" ], + $reference_packages{$package}->{exitcode}, + $reference_packages{$package}->{stdout_re}, + $reference_packages{$package}->{stderr_re}); + } + # XXX this is JUST like test_unit(), when the tests work, refactor! + +} + sub main { test_get_vartypes_basictypes(); test_get_vartypes_map(); test_checkline_mk_vartype_basic(); test_main(); + test_lint_some_reference_packages(); } main(); -- cgit v1.2.3