From aebd104fcfa0b7dfd9acb95fdb66769570b59d10 Mon Sep 17 00:00:00 2001
From: "H.Merijn Brand" <merijn@nb09.procura.nl>
Date: Fri, 26 Sep 2008 10:30:58 +0200
Subject: [PATCH] Ahh, hell, sv_dump changes a lot over versions Almost
 impossible to test version-independent

---
 DDumper.pm     |   6 ++--
 t/30_DDump-s.t | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 96 insertions(+), 15 deletions(-)
 rewrite t/30_DDump-s.t (66%)

diff --git a/DDumper.pm b/DDumper.pm
index 94d0b45..e7daa2c 100644
--- a/DDumper.pm
+++ b/DDumper.pm
@@ -64,7 +64,7 @@ sub _DDump_ref
 	    }
 	return { %hash };
 	}
-    $var;
+    undef;
     } # _DDump_ref
 
 sub _DDump
@@ -72,10 +72,12 @@ sub _DDump
     my ($var, $down, $dump, $fh) = (@_, "");
 
     if ($has_perlio and open $fh, ">", \$dump) {
+	#print STDERR "Using DDump_IO\n";
 	DDump_IO ($fh, $var, $down);
 	close $fh;
 	}
     else {
+	#print STDERR "Using DDump_XS\n";
 	$dump = DDump_XS ($var);
 	}
 
@@ -98,7 +100,7 @@ sub DDump ($;$)
 	    }
 
 	$down && ref $var and
-	    $hash{RV} = _DDump_ref ($var, $down - 1);
+	    $hash{RV} = _DDump_ref ($var, $down - 1) || $var;
 	return %hash;
 	}
 
diff --git a/t/30_DDump-s.t b/t/30_DDump-s.t
dissimilarity index 66%
index 0fbdd84..58f9dbe 100644
--- a/t/30_DDump-s.t
+++ b/t/30_DDump-s.t
@@ -1,13 +1,92 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 1;
-
-BEGIN {
-    use_ok "DDumper";
-    plan skip_all => "Cannot load DDumper" if $@;
-    }
-
-1;
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+#use Test::More tests => 1;
+ use Test::More "no_plan";
+
+use DDumper;
+
+$DDumper::has_perlio = $DDumper::has_perlio = 0;
+
+ok (1, "DDump () NOT using PerlIO");
+
+my @tests;
+{   local $/ = "==\n";
+    chomp (@tests = <DATA>);
+    }
+
+# Determine what newlines this perl generates in sv_peek
+my @nl = ("\\n", "\\n");
+{   if ($] >= 5.008) {
+	my $nl = "\n\x{20ac}";
+	chop $nl;
+	$nl = DPeek ($nl);
+	@nl = ($nl =~ m/"([^"]+)".*"([^"]+)"/);
+	}
+    ok (1, "This perl dumps \\n as (@nl)");
+    }
+
+my $var = "";
+
+foreach my $test (@tests) {
+    my ($in, $out) = split m/\n--\n/ => $test;
+    $in eq "" and next;
+    SKIP: {
+	$in =~ m/20ac/ and $] < 5.008 and skip "No UTF8 in ancient perl", 1;
+
+	eval "\$var = $in;";
+	my $dump = DDump ($var);
+	$dump =~ s/\b0x[0-9a-f]+\b/0x****/g;
+	$dump =~ s/\b(REFCNT =) [0-9]{4,}/$1 -1/g;
+	# Catch differences in \n
+	$dump =~ s/"ab\Q$nl[0]\E(.*?)"ab\Q$nl[1]\E/"ab\\n$1"ab\\n/;
+
+	$dump =~ s/\bLEN = [1-3]\b/LEN = 4/;
+
+	$dump =~ s/\bPADBUSY\b,?//g	if $] < 5.010;
+
+	$dump =~ s/\bUV = /IV = /g	if $] < 5.008;
+	$dump =~ s/,?\bIsUV\b//g	if $] < 5.008;
+
+	$in =~ s/[\s\n]+/ /g;
+	is ($dump, $out, "DDump ($in)");
+	}
+    }
+
+1;
+
+__END__
+undef
+--
+SV = PV(0x****) at 0x****
+  REFCNT = 1
+  FLAGS = (PADMY)
+  PV = 0
+==
+0
+--
+SV = PVIV(0x****) at 0x****
+  REFCNT = 1
+  FLAGS = (PADMY,IOK,pIOK)
+  IV = 0
+  PV = 0
+==
+1
+--
+SV = PVIV(0x****) at 0x****
+  REFCNT = 1
+  FLAGS = (PADMY,IOK,pIOK)
+  IV = 1
+  PV = 0
+==
+""
+--
+SV = PVIV(0x****) at 0x****
+  REFCNT = 1
+  FLAGS = (PADMY,POK,pPOK)
+  IV = 1
+  PV = 0x**** ""\0
+  CUR = 0
+  LEN = 4
-- 
2.11.4.GIT