This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In Win32 the cmd.exe console output doesn't seem to
[perl5.git] / lib / perl5db / dumpvar.t
index 74fb1f9..dff7bb2 100644 (file)
@@ -8,40 +8,152 @@ BEGIN {
 use strict;
 
 $|=1;
-undef $/;
-my @prgs = split "########\n", <DATA>;
-close DATA;
-print "1..", scalar @prgs, "\n";
+
+my @prgs;
+{
+    local $/;
+    @prgs = split "########\n", <DATA>;
+    close DATA;
+}
+
+use Test::More;
+
+plan tests => scalar @prgs;
+
 require "dumpvar.pl";
 
-my $i = 0;
-for (@prgs){
-    my($prog,$expected) = split(/\nEXPECT\n?/, $_);
-    open my $select, ">", \my $got or die;
-    select $select;
+sub unctrl    { print dumpvar::unctrl($_[0]), "\n" }
+sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
+sub stringify { print dumpvar::stringify($_[0]), "\n" }
+
+package Foo;
+
+sub new { my $class = shift; bless [ @_ ], $class }
+
+package Bar;
+
+sub new { my $class = shift; bless [ @_ ], $class }
+
+use overload '""' => sub { "Bar<@{$_[0]}>" };
+
+package main;
+
+my $foo = Foo->new(1..5);
+my $bar = Bar->new(1..5);
+
+for (@prgs) {
+    my($prog, $expected) = split(/\nEXPECT\n?/, $_);
+    # 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.
+    my $out = tie *STDOUT, 'TieOut';
     eval $prog;
-    my $not = "";
-    my $why = "";
-    if ($@) {
-        $not = "not ";
-        $why = " # prog[$prog]\$\@[$@]";
-    } elsif ($got ne $expected) {
-        $not = "not ";
-        $why = " # prog[$prog]got[$got]expected[$expected]";
+    my $ERR = $@;
+    untie $out;
+    if ($ERR) {
+        ok(0, "$prog - $ERR");
+    } else {
+       if ($expected =~ m:^/:) {
+           like($$out, $expected, $prog);
+       } else {
+           is($$out, $expected, $prog);
+       }
     }
-    close $select;
-    select STDOUT;
-    print $not, "ok ", ++$i, $why, "\n";
+}
+
+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
+A
+########
+unctrl("\cA");
+EXPECT
+^A
+########
+uniescape("A");
+EXPECT
+A
+########
+uniescape("\x{100}");
+EXPECT
+\x{0100}
+########
+stringify(undef);
+EXPECT
+undef
+########
+stringify("foo");
+EXPECT
+'foo'
+########
+stringify("\cA");
 EXPECT
+"\cA"
+########
+stringify(*a);
+EXPECT
+*main::a
+########
+stringify(\undef);
+EXPECT
+/^'SCALAR\(0x[0-9a-f]+\)'$/i
+########
+stringify([]);
+EXPECT
+/^'ARRAY\(0x[0-9a-f]+\)'$/i
+########
+stringify({});
+EXPECT
+/^'HASH\(0x[0-9a-f]+\)'$/i
+########
+stringify(sub{});
+EXPECT
+/^'CODE\(0x[0-9a-f]+\)'$/i
+########
+stringify(\*a);
+EXPECT
+/^'GLOB\(0x[0-9a-f]+\)'$/i
+########
+stringify($foo);
+EXPECT
+/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
+########
+stringify($bar);
+EXPECT
+/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
+########
+dumpValue(undef);
+EXPECT
+undef
 ########
 dumpValue(1);
 EXPECT
 1
 ########
+dumpValue("\cA");
+EXPECT
+"\cA"
+########
+dumpValue("\x{100}");
+EXPECT
+'\x{0100}'
+########
 dumpValue("1\n2\n3");
 EXPECT
 '1
@@ -59,3 +171,19 @@ EXPECT
 1 => 2
 3 => 4
 ########
+dumpValue($foo,1);
+EXPECT
+0  1
+1  2
+2  3
+3  4
+4  5
+########
+dumpValue($bar,1);
+EXPECT
+0  1
+1  2
+2  3
+3  4
+4  5
+########