diff options
| -rw-r--r-- | Test.pm | 254 | ||||
| -rwxr-xr-x | debian/rules | 112 | ||||
| -rw-r--r-- | me.info | 0 |
3 files changed, 95 insertions, 271 deletions
diff --git a/Test.pm b/Test.pm deleted file mode 100644 index 55f80ac2..00000000 --- a/Test.pm +++ /dev/null @@ -1,254 +0,0 @@ -use strict; -package Test; -use Test::Harness 1.1501 (); -use Carp; -use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish - qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish -$VERSION = '1.13'; -require Exporter; -@ISA=('Exporter'); -@EXPORT=qw(&plan &ok &skip); -@EXPORT_OK=qw($ntest $TESTOUT); - -$TestLevel = 0; # how many extra stack frames to skip -$|=1; -#$^W=1; ? -$ntest=1; -$TESTOUT = *STDOUT{IO}; - -# Use of this variable is strongly discouraged. It is set mainly to -# help test coverage analyzers know which test is running. -$ENV{REGRESSION_TEST} = $0; - -sub plan { - croak "Test::plan(%args): odd number of arguments" if @_ & 1; - croak "Test::plan(): should not be called more than once" if $planned; - my $max=0; - for (my $x=0; $x < @_; $x+=2) { - my ($k,$v) = @_[$x,$x+1]; - if ($k =~ /^test(s)?$/) { $max = $v; } - elsif ($k eq 'todo' or - $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } - elsif ($k eq 'onfail') { - ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE"; - $ONFAIL = $v; - } - else { carp "Test::plan(): skipping unrecognized directive '$k'" } - } - my @todo = sort { $a <=> $b } keys %todo; - if (@todo) { - print $TESTOUT "1..$max todo ".join(' ', @todo).";\n"; - } else { - print $TESTOUT "1..$max\n"; - } - ++$planned; -} - -sub to_value { - my ($v) = @_; - (ref $v or '') eq 'CODE' ? $v->() : $v; -} - -sub ok ($;$$) { - croak "ok: plan before you test!" if !$planned; - my ($pkg,$file,$line) = caller($TestLevel); - my $repetition = ++$history{"$file:$line"}; - my $context = ("$file at line $line". - ($repetition > 1 ? " fail \#$repetition" : '')); - my $ok=0; - my $result = to_value(shift); - my ($expected,$diag); - if (@_ == 0) { - $ok = $result; - } else { - $expected = to_value(shift); - my ($regex,$ignore); - if (!defined $expected) { - $ok = !defined $result; - } elsif (!defined $result) { - $ok = 0; - } elsif ((ref($expected)||'') eq 'Regexp') { - $ok = $result =~ /$expected/; - } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or - ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) { - $ok = $result =~ /$regex/; - } else { - $ok = $result eq $expected; - } - } - my $todo = $todo{$ntest}; - if ($todo and $ok) { - $context .= ' TODO?!' if $todo; - print $TESTOUT "ok $ntest # ($context)\n"; - } else { - print $TESTOUT "not " if !$ok; - print $TESTOUT "ok $ntest\n"; - - if (!$ok) { - my $detail = { 'repetition' => $repetition, 'package' => $pkg, - 'result' => $result, 'todo' => $todo }; - $$detail{expected} = $expected if defined $expected; - $diag = $$detail{diagnostic} = to_value(shift) if @_; - $context .= ' *TODO*' if $todo; - if (!defined $expected) { - if (!$diag) { - print $TESTOUT "# Failed test $ntest in $context\n"; - } else { - print $TESTOUT "# Failed test $ntest in $context: $diag\n"; - } - } else { - my $prefix = "Test $ntest"; - print $TESTOUT "# $prefix got: ". - (defined $result? "'$result'":'<UNDEF>')." ($context)\n"; - $prefix = ' ' x (length($prefix) - 5); - if ((ref($expected)||'') eq 'Regexp') { - $expected = 'qr/'.$expected.'/' - } else { - $expected = "'$expected'"; - } - if (!$diag) { - print $TESTOUT "# $prefix Expected: $expected\n"; - } else { - print $TESTOUT "# $prefix Expected: $expected ($diag)\n"; - } - } - push @FAILDETAIL, $detail; - } - } - ++ $ntest; - $ok; -} - -sub skip ($$;$$) { - my $whyskip = to_value(shift); - if ($whyskip) { - $whyskip = 'skip' if $whyskip =~ m/^\d+$/; - print $TESTOUT "ok $ntest # $whyskip\n"; - ++ $ntest; - 1; - } else { - local($TestLevel) = $TestLevel+1; #ignore this stack frame - &ok; - } -} - -END { - $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL; -} - -1; -__END__ - -=head1 NAME - - Test - provides a simple framework for writing test scripts - -=head1 SYNOPSIS - - use strict; - use Test; - - # use a BEGIN block so we print our plan before MyModule is loaded - BEGIN { plan tests => 14, todo => [3,4] } - - # load your module... - use MyModule; - - ok(0); # failure - ok(1); # success - - ok(0); # ok, expected failure (see todo list, above) - ok(1); # surprise success! - - ok(0,1); # failure: '0' ne '1' - ok('broke','fixed'); # failure: 'broke' ne 'fixed' - ok('fixed','fixed'); # success: 'fixed' eq 'fixed' - ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/ - - ok(sub { 1+1 }, 2); # success: '2' eq '2' - ok(sub { 1+1 }, 3); # failure: '2' ne '3' - ok(0, int(rand(2)); # (just kidding :-) - - my @list = (0,0); - ok @list, 3, "\@list=".join(',',@list); #extra diagnostics - ok 'segmentation fault', '/(?i)success/'; #regex match - - skip($feature_is_missing, ...); #do platform specific test - -=head1 DESCRIPTION - -L<Test::Harness> expects to see particular output when it executes -tests. This module aims to make writing proper test scripts just a -little bit easier (and less error prone :-). - -=head1 TEST TYPES - -=over 4 - -=item * NORMAL TESTS - -These tests are expected to succeed. If they don't something's -screwed up! - -=item * SKIPPED TESTS - -Skip is for tests that might or might not be possible to run depending -on the availability of platform specific features. The first argument -should evaluate to true (think "yes, please skip") if the required -feature is not available. After the first argument, skip works -exactly the same way as do normal tests. - -=item * TODO TESTS - -TODO tests are designed for maintaining an B<executable TODO list>. -These tests are expected NOT to succeed. If a TODO test does succeed, -the feature in question should not be on the TODO list, now should it? - -Packages should NOT be released with succeeding TODO tests. As soon -as a TODO test starts working, it should be promoted to a normal test -and the newly working feature should be documented in the release -notes or change log. - -=back - -=head1 RETURN VALUE - -Both C<ok> and C<skip> return true if their test succeeds and false -otherwise in a scalar context. - -=head1 ONFAIL - - BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } } - -While test failures should be enough, extra diagnostics can be -triggered at the end of a test run. C<onfail> is passed an array ref -of hash refs that describe each test failure. Each hash will contain -at least the following fields: C<package>, C<repetition>, and -C<result>. (The file, line, and test number are not included because -their correspondence to a particular test is tenuous.) If the test -had an expected value or a diagnostic string, these will also be -included. - -The B<optional> C<onfail> hook might be used simply to print out the -version of your package and/or how to report problems. It might also -be used to generate extremely sophisticated diagnostics for a -particularly bizarre test failure. However it's not a panacea. Core -dumps or other unrecoverable errors prevent the C<onfail> hook from -running. (It is run inside an C<END> block.) Besides, C<onfail> is -probably over-kill in most cases. (Your test code should be simpler -than the code it is testing, yes?) - -=head1 SEE ALSO - -L<Test::Harness> and, perhaps, test coverage analysis tools. - -=head1 AUTHOR - -Copyright (c) 1998-1999 Joshua Nathaniel Pritikin. All rights reserved. - -This package is free software and is provided "as is" without express -or implied warranty. It may be used, redistributed and/or modified -under the terms of the Perl Artistic License (see -http://www.perl.com/perl/misc/Artistic.html) - -=cut diff --git a/debian/rules b/debian/rules index 0806a4db..cb042bf7 100755 --- a/debian/rules +++ b/debian/rules @@ -1,42 +1,120 @@ #!/usr/bin/make -f -# Note that I have to refer to debhelper programs witrh ./, to make sure -# I run the most current ones. +# Note that I have to refer to debhelper programs with ./, to make sure +# I run the most current ones. That's also why there is a symlink to the +# current Dh_lib.pm and the current Dh_getopt.pm in this debian/ directory. +# +# This is _not_ a good example of a debhelper rules file. -test_files=dh_lib +# If any automatic script generation is done in building this package, +# be sure to use the new templates from this package. +export DH_AUTOSCRIPTDIR=autoscripts + +# Living dangerously :-) +export DH_COMPAT=2 + +# Figure out the current debhelper version. +VERSION=$(shell expr "`dpkg-parsechangelog 2>/dev/null |grep Version:`" : '.*Version: \(.*\)') + +export DH_VERBOSE=1 build: - ./dh_testdir $(test_files) + # Run regression tests. + $(MAKE) test clean: - ./dh_testdir $(test_files) + ./dh_testdir ./dh_testroot ./dh_clean +test: + ./dh_clean + DH_VERSION=10 perl -MTest::Harness -e 'runtests grep { ! /CVS/ } @ARGV' t/* + ./dh_clean + # Build architecture-dependent files here. binary-arch: build - # We have nothing to do by default. +# Nothing to do. # Build architecture-independent files here. binary-indep: build - ./dh_testdir $(test_files) + ./dh_testdir ./dh_testroot - ./dh_clean + ./dh_clean -k + ./dh_installdirs usr/bin usr/share/debhelper - install -d debian/tmp/usr/bin - find . -perm +111 -maxdepth 1 -type f \ - -exec install -p {} debian/tmp/usr/bin \; - install -d debian/tmp/usr/lib/debhelper - cp dh_lib debian/tmp/usr/lib/debhelper + echo -e "package Dh_Version;\n\$$version='$(VERSION)';" > debian/debhelper/usr/share/debhelper/Dh_Version.pm + find . -perm +111 -maxdepth 1 -type f -not -name "*.pl" \ + -exec install -p {} debian/debhelper/usr/bin \; + cp -a Dh_*.pm debian/debhelper/usr/share/debhelper + cp -a autoscripts debian/debhelper/usr/share/debhelper - ./dh_installdocs TODO + ./dh_installdocs doc/* ./dh_installexamples examples/* -# ./dh_installmenu + ./dh_installmenu ./dh_installmanpages + ./dh_installinfo + # Fix up all man pages, filling in the modification time for them. + # Note this runs beofre the command below so debhelper.1 gets the right + # date on it. + perl -mPOSIX -e ' \ + foreach $$f (@ARGV) { \ + @data=stat($$f); \ + $$date=POSIX::strftime("%d %B %Y",localtime($$data[9])); \ + open (IN,$$f); \ + @lines=<IN>; \ + close IN; \ + $$lines[0]=~s/1 ""/1 "$$date"/; \ + open (OUT,">$$f"); \ + print OUT @lines; \ + close OUT; \ + }' debian/debhelper/usr/man/man1/*.1 + # Fix up the debhelper.1 man page, substituting in a list of all + # debhelper commands. eek! + perl -ne ' \ + s/\\- /(1)\n/; \ + $$collect.=".TP\n.BR $$_" if $$. eq 3 && /^dh_/; \ + close(ARGV) if eof; \ + END { \ + open(I,"debian/debhelper/usr/man/man1/debhelper.1"); \ + @lines=<I>; \ + close I; \ + open(O,">debian/debhelper/usr/man/man1/debhelper.1"); \ + foreach (@lines) { \ + s/#LIST#/$$collect/; \ + print O; \ + } \ + close O; \ + }' *.1 ./dh_installchangelogs +# ./dh_movefiles + ./dh_link ./dh_compress - ./dh_installdebfiles ./dh_fixperms + ./dh_suidregister + ./dh_installdeb + ./dh_gencontrol + ./dh_md5sums ./dh_builddeb +# Install in the proper location on my ftp server and web server. Not intended +# for use by anyone except the author. +OLD_VER=$(shell perl -e '<>;<>;while(<>){last if /^ --/};<>;$$_=<>;print m/\((.*?)\)/'<debian/changelog) +dist: + dpkg-buildpackage -rfakeroot -tc + if [ `hostname` = 'kite' ] ; then \ + cp ../debhelper_$(VERSION).tar.gz ../../public; \ + rm /home/ftp/pub/code/debhelper/* || true; \ + cp debian/changelog /home/pub/programs/debhelper/CHANGES; \ + echo $(VERSION) > /home/pub/programs/debhelper/LATEST-VERSION-IS; \ + cd ..; rm -rf debhelper-$(OLD_VER); \ + [ -f ../public/debhelper_$(OLD_VER).tar.gz ] && \ + tar zxf ../public/debhelper_$(OLD_VER).tar.gz || \ + tar zxf ../outdated/debhelper_$(OLD_VER).tar.gz; \ + diff -r -u --new-file debhelper-$(OLD_VER) debhelper-$(VERSION) > \ + /home/ftp/pub/code/debhelper/diffs/debhelper-$(VERSION).diff; \ + gzip -9f /home/ftp/pub/code/debhelper/diffs/debhelper-$(VERSION).diff; \ + cd /tmp; rm -f debhelper-$(OLD-VER); \ + fi + binary: binary-indep binary-arch -.PHONY: build clean binary-indep binary-arch binary +.PHONY: build clean binary-indep binary-arch binary dist diff --git a/me.info b/me.info deleted file mode 100644 index e69de29b..00000000 --- a/me.info +++ /dev/null |