From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 12 Nov 2001 19:35:33 +0000 (-0500)
Subject: Recoving dup tests for VMS
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ba553610b80f19edb980ef813a96b79c7b82f9fb;p=p5sagit%2Fp5-mst-13.2.git

Recoving dup tests for VMS
Message-Id: <20011112193533.D2888@blackrider>

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

diff --git a/ext/IO/lib/IO/t/io_dup.t b/ext/IO/lib/IO/t/io_dup.t
index 8983a56..5db5ced 100755
--- a/ext/IO/lib/IO/t/io_dup.t
+++ b/ext/IO/lib/IO/t/io_dup.t
@@ -39,14 +39,15 @@ $stderr->fdopen($stdout,"w");
 
 print $stdout "ok 2\n";
 print $stderr "ok 3\n";
-if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-    print `echo ok 4`;
-    print `echo ok 5 1>&2`; # does this *really* work?
-}
-else {
-    system 'echo ok 4';
-    system 'echo ok 5 1>&2';
-}
+
+# Since some systems don't have echo, we use Perl.
+$echo = qq{$^X -le "print q{ok %d}"};
+
+$cmd = sprintf $echo, 4;
+print `$cmd`;
+
+$cmd = sprintf "$echo 1>&2", 5;     
+print `$cmd`;
 
 $stderr->close;
 $stdout->close;
diff --git a/t/io/dup.t b/t/io/dup.t
index a641db7..3d78245 100755
--- a/t/io/dup.t
+++ b/t/io/dup.t
@@ -1,15 +1,18 @@
 #!./perl
 
-# $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
 
+my $test = 1;
 print "1..8\n";
-
 print "ok 1\n";
 
-open(dupout,">&STDOUT");
-open(duperr,">&STDERR");
+open(DUPOUT,">&STDOUT");
+open(DUPERR,">&STDERR");
 
-open(STDOUT,">Io.dup") || die "Can't open stdout";
+open(STDOUT,">Io.dup")  || die "Can't open stdout";
 open(STDERR,">&STDOUT") || die "Can't open stderr";
 
 select(STDERR); $| = 1;
@@ -17,16 +20,31 @@ select(STDOUT); $| = 1;
 
 print STDOUT "ok 2\n";
 print STDERR "ok 3\n";
-    print `echo ok 4`;
-    print `echo ok 5 1>&2`; # does this work?
-    system 'echo ok 6';
-    system 'echo ok 7 1>&2';
+
+# Since some systems don't have echo, we use Perl.
+$echo = qq{$^X -le "print q{ok %d}"};
+
+$cmd = sprintf $echo, 4;            
+print `$cmd`;
+
+$cmd = sprintf "$echo 1>&2", 5;     
+print `$cmd`;
+
+# KNOWN BUG system() does not honor STDOUT redirections on VMS.
+if( $^O eq 'VMS' ) {
+    print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n" 
+      for 6..7;
+}
+else {
+    system sprintf $echo, 6;
+    system sprintf "$echo 1>&2", 7;
+}
 
 close(STDOUT);
 close(STDERR);
 
-open(STDOUT,">&dupout");
-open(STDERR,">&duperr");
+open(STDOUT,">&DUPOUT");
+open(STDERR,">&DUPERR");
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) { print `type Io.dup` }
 else                  { system 'cat Io.dup' }
diff --git a/vms/test.com b/vms/test.com
index e2b9503..62532f5 100644
--- a/vms/test.com
+++ b/vms/test.com
@@ -102,7 +102,7 @@ $   PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'")
 $   Define 'dbg'Perlshr 'PerlShr_filespec'
 $   MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'"
 $   Deck/Dollar=$$END-OF-TEST$$
-# $RCSfile: test.com,v $$Revision: 1.1 $$Date: 2001/11/07 06:58:50 $
+# $RCSfile: test.com,v $$Revision: 1.1 $$Date: 2001/11/13 00:26:19 $
 # Modified for VMS 30-Sep-1994  Charles Bailey  bailey@newman.upenn.edu
 #
 # This is written in a peculiar style, since we're trying to avoid
@@ -115,8 +115,7 @@ use Config;
 use File::Spec;
 
 @compexcl=('cpp.t');
-@ioexcl=('dup.t');
-@libexcl=('io_dup.t', 'io_pipe.t', 'io_poll.t', 'io_sel.t',
+@libexcl=('io_pipe.t', 'io_poll.t', 'io_sel.t',
           'io_sock.t', 'io_unix.t');
 
 # io_xs.t tests the new_tmpfile routine, which doesn't work with the