This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Uncomment and fix up tests at the end of Storable's blessed.t
[perl5.git] / t / comp / opsubs.t
index f9822e9..89b1af5 100644 (file)
@@ -12,7 +12,12 @@ my $test = 0;
 sub failed {
     my ($got, $expected, $name) = @_;
 
-    print "not ok $test - $name\n";
+    if ($::TODO) {
+       print "not ok $test - $name # TODO: $::TODO\n";
+    }
+    else {
+       print "not ok $test - $name\n";
+    }
     my @caller = caller(1);
     print "# Failed test at $caller[1] line $caller[2]\n";
     if (defined $got) {
@@ -28,39 +33,59 @@ sub like {
     my ($got, $pattern, $name) = @_;
     $test = $test + 1;
     if (defined $got && $got =~ $pattern) {
-       print "ok $test - $name\n";
+       if ($::TODO) {
+           print "ok $test - $name # TODO: $::TODO\n";
+       }
+       else {
+           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);
+    failed($got, $pattern, $name);
 }
 
 sub is {
     my ($got, $expect, $name) = @_;
     $test = $test + 1;
     if (defined $got && $got eq $expect) {
-       print "ok $test - $name\n";
+       if ($::TODO) {
+           print "ok $test - $name # TODO: $::TODO\n";
+       }
+       else {
+           print "ok $test - $name\n";
+       }
        return 1;
     }
-    failed($got, "'$expect'");
+    failed($got, "'$expect'", $name);
 }
 
 sub isnt {
     my ($got, $expect, $name) = @_;
     $test = $test + 1;
     if (defined $got && $got ne $expect) {
-       print "ok $test - $name\n";
+       if ($::TODO) {
+           print "ok $test - $name # TODO: $::TODO\n";
+       }
+       else {
+           print "ok $test - $name\n";
+       }
        return 1;
     }
-    failed($got, "not '$expect'");
+    failed($got, "not '$expect'", $name);
 }
 
 sub can_ok {
     my ($class, $method) = @_;
     $test = $test + 1;
     if (eval { $class->can($method) }) {
-       print "ok $test - $class->can('$method')\n";
+       if ($::TODO) {
+           print "ok $test - $class->can('$method') # TODO: $::TODO\n";
+       }
+       else {
+           print "ok $test - $class->can('$method')\n";
+       }
        return 1;
     }
     my @caller = caller;
@@ -125,8 +150,8 @@ can_ok( 'main', "qx" );
 eval "qx('unqualified'".
      ($^O eq 'MSWin32' ? " 2>&1)" : ")");
 TODO: {
-       local $::TODO = $^O eq 'MSWin32' ? "Tainting of PATH not working of Windows" : $::TODO;
-       like( $@, qr/^Insecure/, "qx('unqualified') doesn't work" );
+    local $::TODO = $^O eq 'MSWin32' ? "Tainting of PATH not working of Windows" : $::TODO;
+    like( $@, qr/^Insecure/, "qx('unqualified') doesn't work" );
 }
 is( main::qx('main'), "qx-main", "main::qx() is func" );
 is( &qx('amper'), "qx-amper", "&qx() is func" );