From: Michael G. Schwern <schwern@pobox.com>
Date: Fri, 7 Dec 2001 19:41:31 +0000 (-0500)
Subject: Declaring mostly TODO
X-Git-Tag: accepted/trunk/20130322.191538~28976
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=b734d6c9a69b651b431318a8a85ae26a06dc580e;p=platform%2Fupstream%2Fperl.git

Declaring mostly TODO
Message-ID: <20011208004131.GC642@blackrider>

p4raw-id: //depot/perl@13529
---

diff --git a/t/run/switches.t b/t/run/switches.t
index 04b9630..67331b6 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -11,6 +11,10 @@ require "./test.pl";
 
 plan(tests => 14);
 
+# due to a bug in VMS's piping which makes it impossible for runperl()
+# to emulate echo -n, these tests almost totally fail.
+$TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
+
 my $r;
 my @tmpfiles = ();
 END { unlink @tmpfiles }
@@ -63,6 +67,8 @@ is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
 
 my $filename = 'swctest.tmp';
 SKIP: {
+    local $TODO = '';   # this one works on VMS
+
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
     print $f <<'SWTEST';
 BEGIN { print "block 1\n"; }
@@ -122,7 +128,7 @@ SWTEST
 	progfile    => $filename,
 	args	    => [ '-x=foo' ],
     );
-    is( $r, 'foo', '-s on the #! line' );
+    is( $r, 'foo', '-s on the shebang line' );
     push @tmpfiles, $filename;
 }
 
@@ -151,7 +157,11 @@ SWTESTPM
 	switches    => [ '-mswtest' ],
 	prog	    => '1',
     );
-    is( $r, '', '-m' );
+
+    {
+        local $TODO = '';  # this one works on VMS
+        is( $r, '', '-m' );
+    }
     $r = runperl(
 	switches    => [ '-mswtest=foo,bar' ],
 	prog	    => '1',
diff --git a/t/test.pl b/t/test.pl
index 5a81d54..c5259de 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -41,6 +41,8 @@ sub _ok {
     # VMS will avenge.
     my $out;
     if ($name) {
+        # escape out '#' or it will interfere with '# skip' and such
+        $name =~ s/#/\\#/g;
 	$out = $pass ? "ok $test - $name" : "not ok $test - $name";
     } else {
 	$out = $pass ? "ok $test" : "not ok $test";