From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 9 Oct 2009 12:13:55 +0000 (+0200)
Subject: Don't use require in comp/parser.t, as require isn't tested yet.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9786f600ff793ec8526cb8722afafeff5cf741e;p=p5sagit%2Fp5-mst-13.2.git

Don't use require in comp/parser.t, as require isn't tested yet.

Emit TAP directly.
---

diff --git a/t/comp/parser.t b/t/comp/parser.t
index 9e1d427..d0e7f5d 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -3,13 +3,52 @@
 # Checks if the parser behaves correctly in edge cases
 # (including weird syntax errors)
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
+print "1..112\n";
+
+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;
 }
 
-BEGIN { require "./test.pl"; }
-plan( tests => 112 );
+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 $expect) {
+	if (defined $got && $got eq $expect) {
+	    print "ok $test - $name\n";
+	    return 1;
+	}
+	failed($got, "'$expect'", $name);
+    } else {
+	if (!defined $got) {
+	    print "ok $test - $name\n";
+	    return 1;
+	}
+	failed($got, 'undef', $name);
+    }
+}
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -109,7 +148,8 @@ my %data = ( foo => "\n" );
 print "#";
 print(
 $data{foo});
-pass();
+$test = $test + 1;
+print "ok $test\n";
 
 # Bug #21875
 # { q.* => ... } should be interpreted as hash, not block
@@ -127,7 +167,7 @@ EOF
 {
     my ($expect, $eval) = split / /, $line, 2;
     my $result = eval $eval;
-    ok($@ eq  '', "eval $eval");
+    is($@, '', "eval $eval");
     is(ref $result, $expect ? 'HASH' : '', $eval);
 }
 
@@ -160,7 +200,8 @@ EOF
     # this used to segfault (because $[=1 is optimized away to a null block)
     my $x;
     $[ = 1 while $x;
-    pass();
+    $test = $test + 1;
+    print "ok $test\n";
     $[ = 0; # restore the original value for less side-effects
 }
 
@@ -180,9 +221,11 @@ EOF
 {
     my $x;
     $x = 1 for ($[) = 0;
-    pass('optimized assignment to $[ used to segfault in list context');
+    $test = $test + 1;
+    print "ok $test - optimized assignment to \$[ used to segfault in list context\n";
     if ($[ = 0) { $x = 1 }
-    pass('optimized assignment to $[ used to segfault in scalar context');
+    $test = $test + 1;
+    print "ok $test - optimized assignment to \$[ used to segfault in scalar context\n";
     $x = ($[=2.4);
     is($x, 2, 'scalar assignment to $[ behaves like other variables');
     $x = (($[) = 0);