From: Nicholas Clark Date: Fri, 9 Oct 2009 11:48:43 +0000 (+0200) Subject: Don't use require in comp/uproto.t, as require isn't tested yet. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf1e28d2637f0459847074ab67bb30cc13d0473a;p=p5sagit%2Fp5-mst-13.2.git Don't use require in comp/uproto.t, as require isn't tested yet. Emit TAP directly. --- diff --git a/t/comp/uproto.t b/t/comp/uproto.t index 265854f..c899b68 100644 --- a/t/comp/uproto.t +++ b/t/comp/uproto.t @@ -1,12 +1,52 @@ #!perl -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require "./test.pl"; +print "1..39\n"; +my $test = 0; + +sub failed { + my ($got, $expected) = @_; + + print "not ok $test\n"; + my @caller = caller(1); + print "# Failed test at $caller[1] line $caller[2]\n"; + if (defined $got) { + print "# Got '$got'\n"; + } else { + print "# Got undef\n"; + } + print "# Expected $expected\n"; + return; } -plan(tests => 39); +sub like { + my ($got, $pattern) = @_; + $test = $test + 1; + if (defined $got && $got =~ $pattern) { + print "ok $test\n"; + # Principle of least surprise - maintain the expected interface, even + # though we aren't using it here (yet). + return 1; + } + failed($got, $pattern); +} + +sub is { + my ($got, $expect) = @_; + $test = $test + 1; + if (defined $expect) { + if (defined $got && $got eq $expect) { + print "ok $test\n"; + return 1; + } + failed($got, "'$expect'"); + } else { + if (!defined $got) { + print "ok $test\n"; + return 1; + } + failed($got, 'undef'); + } +} sub f($$_) { my $x = shift; is("@_", $x) }