From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 8 Sep 2003 06:31:39 +0000 (+0000)
Subject: More dumpvar testing.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f97a9a4b11bc5c17f0a5caadd0d46e4be5b95cba;p=p5sagit%2Fp5-mst-13.2.git

More dumpvar testing.

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

diff --git a/lib/perl5db/dumpvar.t b/lib/perl5db/dumpvar.t
index d1194b9..b60afa6 100644
--- a/lib/perl5db/dumpvar.t
+++ b/lib/perl5db/dumpvar.t
@@ -26,8 +26,30 @@ plan tests => scalar @prgs;
 
 require "dumpvar.pl";
 
+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.
     open my $select, ">", \my $got or die;
     select $select;
     eval $prog;
@@ -37,15 +59,91 @@ for (@prgs) {
     if ($ERR) {
         ok(0, "$prog - $ERR");
     } else {
-        is($got, $expected, $prog);
+	if ($expected =~ m:^/:) {
+	    like($got, $expected, $prog);
+	} else {
+	    is($got, $expected, $prog);
+	}
     }
 }
 
 __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
@@ -63,3 +161,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
+########