summaryrefslogtreecommitdiff
path: root/lib/perl5db
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2003-09-08 09:10:47 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2003-09-08 09:10:47 +0000
commit1d8663a3de8493970219ce238d848787b038398b (patch)
treec0def6d737b6fd2c56723cfb6adfdcc05958a72d /lib/perl5db
parent45369eab82251b155cde21ed5f7a3211f42adc8e (diff)
downloadperl-1d8663a3de8493970219ce238d848787b038398b.tar.gz
In Win32 the cmd.exe console output doesn't seem to
be catchable using the in-memory I/O + select trick, so use tie-STDOUT trick instead. p4raw-id: //depot/perl@21078
Diffstat (limited to 'lib/perl5db')
-rw-r--r--lib/perl5db/dumpvar.t30
1 files changed, 20 insertions, 10 deletions
diff --git a/lib/perl5db/dumpvar.t b/lib/perl5db/dumpvar.t
index b60afa6275..dff7bb23dc 100644
--- a/lib/perl5db/dumpvar.t
+++ b/lib/perl5db/dumpvar.t
@@ -3,10 +3,6 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
- unless (find PerlIO::Layer 'perlio') { # PerlIO::scalar
- print "1..0 # Skip: not perlio\n";
- exit 0;
- }
}
use strict;
@@ -50,23 +46,37 @@ for (@prgs) {
# TODO: dumpvar::stringify() is controlled by a pile of package
# dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
# and so forth. We need to test with various settings of those.
- open my $select, ">", \my $got or die;
- select $select;
+ my $out = tie *STDOUT, 'TieOut';
eval $prog;
my $ERR = $@;
- close $select;
- select STDOUT;
+ untie $out;
if ($ERR) {
ok(0, "$prog - $ERR");
} else {
if ($expected =~ m:^/:) {
- like($got, $expected, $prog);
+ like($$out, $expected, $prog);
} else {
- is($got, $expected, $prog);
+ is($$out, $expected, $prog);
}
}
}
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $self), $_[0] );
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
+
+sub read {
+ my $self = shift;
+ substr( $$self, 0, length($$self), '' );
+}
+
__END__
unctrl("A");
EXPECT