From: Nicholas Clark Date: Fri, 9 Oct 2009 17:18:52 +0000 (+0200) Subject: Don't use require in comp/fold.t, as require isn't tested yet. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=76c3cfbe78336e0cb070b0aac1ead2413441af81;p=p5sagit%2Fp5-mst-13.2.git Don't use require in comp/fold.t, as require isn't tested yet. Emit TAP directly. --- diff --git a/t/comp/fold.t b/t/comp/fold.t index 0e507c3..23e8e89 100644 --- a/t/comp/fold.t +++ b/t/comp/fold.t @@ -1,12 +1,11 @@ #!./perl -w -require './test.pl'; - # Uncomment this for testing, but don't leave it in for "production", as # we've not yet verified that use works. # use strict; -plan (13); +print "1..13\n"; +my $test = 0; # Historically constant folding was performed by evaluating the ops, and if # they threw an exception compilation failed. This was seen as buggy, because @@ -16,6 +15,43 @@ plan (13); # optimisation rather than a behaviour change. +sub failed { + my ($got, $expected, $name) = @_; + + print "not ok $test - $name\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; +} + +sub like { + my ($got, $pattern, $name) = @_; + $test = $test + 1; + if (defined $got && $got =~ $pattern) { + print "ok $test - $name\n"; + # Principle of least surprise - maintain the expected interface, even + # though we aren't using it here (yet). + return 1; + } + failed($got, $pattern, $name); +} + +sub is { + my ($got, $expect, $name) = @_; + $test = $test + 1; + if (defined $got && $got eq $expect) { + print "ok $test - $name\n"; + return 1; + } + failed($got, "'$expect'", $name); +} + my $a; $a = eval '$b = 0/0 if 0; 3'; is ($a, 3, 'constants in conditionals don\'t affect constant folding');