Dual-life Dumpvalue

3 files changed, 1 insertions, 943 deletions

diff --git a/lib/.gitignore b/lib/.gitignore
index 873e8a40e0..ff39f0e5dc 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -123,6 +123,7 @@
 /Digest/SHA.pm
 /Digest/base.pm
 /Digest/file.pm
+/Dumpvalue.pm
 /DynaLoader.pm
 /Encode
 /Encode.pm
diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm
deleted file mode 100644
index f1ec0fbfb4..0000000000
--- a/lib/Dumpvalue.pm
+++ /dev/null
@@ -1,648 +0,0 @@
-use 5.006_001;			# for (defined ref) and $#$v and our
-package Dumpvalue;
-use strict;
-our $VERSION = '1.14';
-our(%address, $stab, @stab, %stab, %subs);
-
-# documentation nits, handle complex data structures better by chromatic
-# translate control chars to ^X - Randal Schwartz
-# Modifications to print types by Peter Gordon v1.0
-
-# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
-
-# Won't dump symbol tables and contents of debugged files by default
-
-# (IZ) changes for objectification:
-#   c) quote() renamed to method set_quote();
-#   d) unctrlSet() renamed to method set_unctrl();
-#   f) Compiles with `use strict', but in two places no strict refs is needed:
-#      maybe more problems are waiting...
-
-my %defaults = (
-		globPrint	      => 0,
-		printUndef	      => 1,
-		tick		      => "auto",
-		unctrl		      => 'quote',
-		subdump		      => 1,
-		dumpReused	      => 0,
-		bareStringify	      => 1,
-		hashDepth	      => '',
-		arrayDepth	      => '',
-		dumpDBFiles	      => '',
-		dumpPackages	      => '',
-		quoteHighBit	      => '',
-		usageOnly	      => '',
-		compactDump	      => '',
-		veryCompact	      => '',
-		stopDbSignal	      => '',
-	       );
-
-sub new {
-  my $class = shift;
-  my %opt = (%defaults, @_);
-  bless \%opt, $class;
-}
-
-sub set {
-  my $self = shift;
-  my %opt = @_;
-  @$self{keys %opt} = values %opt;
-}
-
-sub get {
-  my $self = shift;
-  wantarray ? @$self{@_} : $$self{pop @_};
-}
-
-sub dumpValue {
-  my $self = shift;
-  die "usage: \$dumper->dumpValue(value)" unless @_ == 1;
-  local %address;
-  local $^W=0;
-  (print "undef\n"), return unless defined $_[0];
-  (print $self->stringify($_[0]), "\n"), return unless ref $_[0];
-  $self->unwrap($_[0],0);
-}
-
-sub dumpValues {
-  my $self = shift;
-  local %address;
-  local $^W=0;
-  (print "undef\n"), return unless defined $_[0];
-  $self->unwrap(\@_,0);
-}
-
-# This one is good for variable names:
-
-sub unctrl {
-  local($_) = @_;
-
-  return \$_ if ref \$_ eq "GLOB";
-  s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
-  $_;
-}
-
-sub stringify {
-  my $self = shift;
-  local $_ = shift;
-  my $noticks = shift;
-  my $tick = $self->{tick};
-
-  return 'undef' unless defined $_ or not $self->{printUndef};
-  return $_ . "" if ref \$_ eq 'GLOB';
-  { no strict 'refs';
-    $_ = &{'overload::StrVal'}($_)
-      if $self->{bareStringify} and ref $_
-	and %overload:: and defined &{'overload::StrVal'};
-  }
-
-  if ($tick eq 'auto') {
-    if (/[\000-\011\013-\037\177]/) {
-      $tick = '"';
-    } else {
-      $tick = "'";
-    }
-  }
-  if ($tick eq "'") {
-    s/([\'\\])/\\$1/g;
-  } elsif ($self->{unctrl} eq 'unctrl') {
-    s/([\"\\])/\\$1/g ;
-    s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
-    s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg
-      if $self->{quoteHighBit};
-  } elsif ($self->{unctrl} eq 'quote') {
-    s/([\"\\\$\@])/\\$1/g if $tick eq '"';
-    s/\033/\\e/g;
-    s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
-  }
-  s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit};
-  ($noticks || /^\d+(\.\d*)?\Z/)
-    ? $_
-      : $tick . $_ . $tick;
-}
-
-sub DumpElem {
-  my ($self, $v) = (shift, shift);
-  my $short = $self->stringify($v, ref $v);
-  my $shortmore = '';
-  if ($self->{veryCompact} && ref $v
-      && (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) {
-    my $depth = $#$v;
-    ($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1)
-      if $self->{arrayDepth} and $depth >= $self->{arrayDepth};
-    my @a = map $self->stringify($_), @$v[0..$depth];
-    print "0..$#{$v}  @a$shortmore\n";
-  } elsif ($self->{veryCompact} && ref $v
-	   && (ref $v eq 'HASH') and !grep(ref $_, values %$v)) {
-    my @a = sort keys %$v;
-    my $depth = $#a;
-    ($shortmore, $depth) = (' ...', $self->{hashDepth} - 1)
-      if $self->{hashDepth} and $depth >= $self->{hashDepth};
-    my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})}
-      @a[0..$depth];
-    local $" = ', ';
-    print "@b$shortmore\n";
-  } else {
-    print "$short\n";
-    $self->unwrap($v,shift);
-  }
-}
-
-sub unwrap {
-  my $self = shift;
-  return if $DB::signal and $self->{stopDbSignal};
-  my ($v) = shift ;
-  my ($s) = shift ;		# extra no of spaces
-  my $sp;
-  my (%v,@v,$address,$short,$fileno);
-
-  $sp = " " x $s ;
-  $s += 3 ;
-
-  # Check for reused addresses
-  if (ref $v) {
-    my $val = $v;
-    { no strict 'refs';
-      $val = &{'overload::StrVal'}($v)
-	if %overload:: and defined &{'overload::StrVal'};
-    }
-    ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
-    if (!$self->{dumpReused} && defined $address) {
-      $address{$address}++ ;
-      if ( $address{$address} > 1 ) {
-	print "${sp}-> REUSED_ADDRESS\n" ;
-	return ;
-      }
-    }
-  } elsif (ref \$v eq 'GLOB') {
-    $address = "$v" . "";	# To avoid a bug with globs
-    $address{$address}++ ;
-    if ( $address{$address} > 1 ) {
-      print "${sp}*DUMPED_GLOB*\n" ;
-      return ;
-    }
-  }
-
-  if (ref $v eq 'Regexp') {
-    my $re = "$v";
-    $re =~ s,/,\\/,g;
-    print "$sp-> qr/$re/\n";
-    return;
-  }
-
-  if ( UNIVERSAL::isa($v, 'HASH') ) {
-    my @sortKeys = sort keys(%$v) ;
-    my $more;
-    my $tHashDepth = $#sortKeys ;
-    $tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1
-      unless $self->{hashDepth} eq '' ;
-    $more = "....\n" if $tHashDepth < $#sortKeys ;
-    my $shortmore = "";
-    $shortmore = ", ..." if $tHashDepth < $#sortKeys ;
-    $#sortKeys = $tHashDepth ;
-    if ($self->{compactDump} && !grep(ref $_, values %{$v})) {
-      $short = $sp;
-      my @keys;
-      for (@sortKeys) {
-	push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_});
-      }
-      $short .= join ', ', @keys;
-      $short .= $shortmore;
-      (print "$short\n"), return if length $short <= $self->{compactDump};
-    }
-    for my $key (@sortKeys) {
-      return if $DB::signal and $self->{stopDbSignal};
-      my $value = $ {$v}{$key} ;
-      print $sp, $self->stringify($key), " => ";
-      $self->DumpElem($value, $s);
-    }
-    print "$sp  empty hash\n" unless @sortKeys;
-    print "$sp$more" if defined $more ;
-  } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) {
-    my $tArrayDepth = $#{$v} ;
-    my $more ;
-    $tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1
-      unless  $self->{arrayDepth} eq '' ;
-    $more = "....\n" if $tArrayDepth < $#{$v} ;
-    my $shortmore = "";
-    $shortmore = " ..." if $tArrayDepth < $#{$v} ;
-    if ($self->{compactDump} && !grep(ref $_, @{$v})) {
-      if ($#$v >= 0) {
-	$short = $sp . "0..$#{$v}  " .
-	  join(" ", 
-	       map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} (0..$tArrayDepth)
-	      ) . "$shortmore";
-      } else {
-	$short = $sp . "empty array";
-      }
-      (print "$short\n"), return if length $short <= $self->{compactDump};
-    }
-    for my $num (0 .. $tArrayDepth) {
-      return if $DB::signal and $self->{stopDbSignal};
-      print "$sp$num  ";
-      if (exists $v->[$num]) {
-        $self->DumpElem($v->[$num], $s);
-      } else {
-	print "empty slot\n";
-      }
-    }
-    print "$sp  empty array\n" unless @$v;
-    print "$sp$more" if defined $more ;
-  } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) {
-    print "$sp-> ";
-    $self->DumpElem($$v, $s);
-  } elsif ( UNIVERSAL::isa($v, 'CODE') ) {
-    print "$sp-> ";
-    $self->dumpsub(0, $v);
-  } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
-    print "$sp-> ",$self->stringify($$v,1),"\n";
-    if ($self->{globPrint}) {
-      $s += 3;
-      $self->dumpglob('', $s, "{$$v}", $$v, 1);
-    } elsif (defined ($fileno = fileno($v))) {
-      print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
-    }
-  } elsif (ref \$v eq 'GLOB') {
-    if ($self->{globPrint}) {
-      $self->dumpglob('', $s, "{$v}", $v, 1);
-    } elsif (defined ($fileno = fileno(\$v))) {
-      print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
-    }
-  }
-}
-
-sub matchvar {
-  $_[0] eq $_[1] or
-    ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and
-      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
-}
-
-sub compactDump {
-  my $self = shift;
-  $self->{compactDump} = shift if @_;
-  $self->{compactDump} = 6*80-1 
-    if $self->{compactDump} and $self->{compactDump} < 2;
-  $self->{compactDump};
-}
-
-sub veryCompact {
-  my $self = shift;
-  $self->{veryCompact} = shift if @_;
-  $self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact};
-  $self->{veryCompact};
-}
-
-sub set_unctrl {
-  my $self = shift;
-  if (@_) {
-    my $in = shift;
-    if ($in eq 'unctrl' or $in eq 'quote') {
-      $self->{unctrl} = $in;
-    } else {
-      print "Unknown value for `unctrl'.\n";
-    }
-  }
-  $self->{unctrl};
-}
-
-sub set_quote {
-  my $self = shift;
-  if (@_ and $_[0] eq '"') {
-    $self->{tick} = '"';
-    $self->{unctrl} = 'quote';
-  } elsif (@_ and $_[0] eq 'auto') {
-    $self->{tick} = 'auto';
-    $self->{unctrl} = 'quote';
-  } elsif (@_) {		# Need to set
-    $self->{tick} = "'";
-    $self->{unctrl} = 'unctrl';
-  }
-  $self->{tick};
-}
-
-sub dumpglob {
-  my $self = shift;
-  return if $DB::signal and $self->{stopDbSignal};
-  my ($package, $off, $key, $val, $all) = @_;
-  local(*stab) = $val;
-  my $fileno;
-  if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined $stab) {
-    print( (' ' x $off) . "\$", &unctrl($key), " = " );
-    $self->DumpElem($stab, 3+$off);
-  }
-  if (($key !~ /^_</ or $self->{dumpDBFiles}) and @stab) {
-    print( (' ' x $off) . "\@$key = (\n" );
-    $self->unwrap(\@stab,3+$off) ;
-    print( (' ' x $off) .  ")\n" );
-  }
-  if ($key ne "main::" && $key ne "DB::" && %stab
-      && ($self->{dumpPackages} or $key !~ /::$/)
-      && ($key !~ /^_</ or $self->{dumpDBFiles})
-      && !($package eq "Dumpvalue" and $key eq "stab")) {
-    print( (' ' x $off) . "\%$key = (\n" );
-    $self->unwrap(\%stab,3+$off) ;
-    print( (' ' x $off) .  ")\n" );
-  }
-  if (defined ($fileno = fileno(*stab))) {
-    print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
-  }
-  if ($all) {
-    if (defined &stab) {
-      $self->dumpsub($off, $key);
-    }
-  }
-}
-
-sub CvGV_name {
-  my $self = shift;
-  my $in = shift;
-  return if $self->{skipCvGV};	# Backdoor to avoid problems if XS broken...
-  $in = \&$in;			# Hard reference...
-  eval {require Devel::Peek; 1} or return;
-  my $gv = Devel::Peek::CvGV($in) or return;
-  *$gv{PACKAGE} . '::' . *$gv{NAME};
-}
-
-sub dumpsub {
-  my $self = shift;
-  my ($off,$sub) = @_;
-  my $ini = $sub;
-  my $s;
-  $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
-  my $subref = defined $1 ? \&$sub : \&$ini;
-  my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s})
-    || (($s = $self->CvGV_name($subref)) && $DB::sub{$s})
-    || ($self->{subdump} && ($s = $self->findsubs("$subref"))
-	&& $DB::sub{$s});
-  $s = $sub unless defined $s;
-  $place = '???' unless defined $place;
-  print( (' ' x $off) .  "&$s in $place\n" );
-}
-
-sub findsubs {
-  my $self = shift;
-  return undef unless %DB::sub;
-  my ($addr, $name, $loc);
-  while (($name, $loc) = each %DB::sub) {
-    $addr = \&$name;
-    $subs{"$addr"} = $name;
-  }
-  $self->{subdump} = 0;
-  $subs{ shift() };
-}
-
-sub dumpvars {
-  my $self = shift;
-  my ($package,@vars) = @_;
-  local(%address,$^W);
-  my ($key,$val);
-  $package .= "::" unless $package =~ /::$/;
-  *stab = *main::;
-
-  while ($package =~ /(\w+?::)/g) {
-    *stab = $ {stab}{$1};
-  }
-  $self->{TotalStrings} = 0;
-  $self->{Strings} = 0;
-  $self->{CompleteTotal} = 0;
-  while (($key,$val) = each(%stab)) {
-    return if $DB::signal and $self->{stopDbSignal};
-    next if @vars && !grep( matchvar($key, $_), @vars );
-    if ($self->{usageOnly}) {
-      $self->globUsage(\$val, $key)
-	if ($package ne 'Dumpvalue' or $key ne 'stab')
-	   and ref(\$val) eq 'GLOB';
-    } else {
-      $self->dumpglob($package, 0,$key, $val);
-    }
-  }
-  if ($self->{usageOnly}) {
-    print <<EOP;
-String space: $self->{TotalStrings} bytes in $self->{Strings} strings.
-EOP
-    $self->{CompleteTotal} += $self->{TotalStrings};
-    print <<EOP;
-Grand total = $self->{CompleteTotal} bytes (1 level deep) + overhead.
-EOP
-  }
-}
-
-sub scalarUsage {
-  my $self = shift;
-  my $size;
-  if (UNIVERSAL::isa($_[0], 'ARRAY')) {
-	$size = $self->arrayUsage($_[0]);
-  } elsif (UNIVERSAL::isa($_[0], 'HASH')) {
-	$size = $self->hashUsage($_[0]);
-  } elsif (!ref($_[0])) {
-	$size = length($_[0]);
-  }
-  $self->{TotalStrings} += $size;
-  $self->{Strings}++;
-  $size;
-}
-
-sub arrayUsage {		# array ref, name
-  my $self = shift;
-  my $size = 0;
-  map {$size += $self->scalarUsage($_)} @{$_[0]};
-  my $len = @{$_[0]};
-  print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n"
-      if defined $_[1];
-  $self->{CompleteTotal} +=  $size;
-  $size;
-}
-
-sub hashUsage {			# hash ref, name
-  my $self = shift;
-  my @keys = keys %{$_[0]};
-  my @values = values %{$_[0]};
-  my $keys = $self->arrayUsage(\@keys);
-  my $values = $self->arrayUsage(\@values);
-  my $len = @keys;
-  my $total = $keys + $values;
-  print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
-    " (keys: $keys; values: $values; total: $total bytes)\n"
-      if defined $_[1];
-  $total;
-}
-
-sub globUsage {			# glob ref, name
-  my $self = shift;
-  local *stab = *{$_[0]};
-  my $total = 0;
-  $total += $self->scalarUsage($stab) if defined $stab;
-  $total += $self->arrayUsage(\@stab, $_[1]) if @stab;
-  $total += $self->hashUsage(\%stab, $_[1]) 
-    if %stab and $_[1] ne "main::" and $_[1] ne "DB::";	
-  #and !($package eq "Dumpvalue" and $key eq "stab"));
-  $total;
-}
-
-1;
-
-=head1 NAME
-
-Dumpvalue - provides screen dump of Perl data.
-
-=head1 SYNOPSIS
-
-  use Dumpvalue;
-  my $dumper = Dumpvalue->new;
-  $dumper->set(globPrint => 1);
-  $dumper->dumpValue(\*::);
-  $dumper->dumpvars('main');
-  my $dump = $dumper->stringify($some_value);
-
-=head1 DESCRIPTION
-
-=head2 Creation
-
-A new dumper is created by a call
-
-  $d = Dumpvalue->new(option1 => value1, option2 => value2)
-
-Recognized options:
-
-=over 4
-
-=item C<arrayDepth>, C<hashDepth>
-
-Print only first N elements of arrays and hashes.  If false, prints all the
-elements.
-
-=item C<compactDump>, C<veryCompact>
-
-Change style of array and hash dump.  If true, short array
-may be printed on one line.
-
-=item C<globPrint>
-
-Whether to print contents of globs.
-
-=item C<dumpDBFiles>
-
-Dump arrays holding contents of debugged files.
-
-=item C<dumpPackages>
-
-Dump symbol tables of packages.
-
-=item C<dumpReused>
-
-Dump contents of "reused" addresses.
-
-=item C<tick>, C<quoteHighBit>, C<printUndef>
-
-Change style of string dump.  Default value of C<tick> is C<auto>, one
-can enable either double-quotish dump, or single-quotish by setting it
-to C<"> or C<'>.  By default, characters with high bit set are printed
-I<as is>.  If C<quoteHighBit> is set, they will be quoted.
-
-=item C<usageOnly>
-
-rudimentally per-package memory usage dump.  If set,
-C<dumpvars> calculates total size of strings in variables in the package.
-
-=item unctrl
-
-Changes the style of printout of strings.  Possible values are
-C<unctrl> and C<quote>.
-
-=item subdump
-
-Whether to try to find the subroutine name given the reference.
-
-=item bareStringify
-
-Whether to write the non-overloaded form of the stringify-overloaded objects.
-
-=item quoteHighBit
-
-Whether to print chars with high bit set in binary or "as is".
-
-=item stopDbSignal
-
-Whether to abort printing if debugger signal flag is raised.
-
-=back
-
-Later in the life of the object the methods may be queries with get()
-method and set() method (which accept multiple arguments).
-
-=head2 Methods
-
-=over 4
-
-=item dumpValue
-
-  $dumper->dumpValue($value);
-  $dumper->dumpValue([$value1, $value2]);
-
-Prints a dump to the currently selected filehandle.
-
-=item dumpValues
-
-  $dumper->dumpValues($value1, $value2);
-
-Same as C<< $dumper->dumpValue([$value1, $value2]); >>.
-
-=item stringify
-
-  my $dump = $dumper->stringify($value [,$noticks] );
-
-Returns the dump of a single scalar without printing. If the second
-argument is true, the return value does not contain enclosing ticks.
-Does not handle data structures.
-
-=item dumpvars
-
-  $dumper->dumpvars('my_package');
-  $dumper->dumpvars('my_package', 'foo', '~bar$', '!......');
-
-The optional arguments are considered as literal strings unless they
-start with C<~> or C<!>, in which case they are interpreted as regular
-expressions (possibly negated).
-
-The second example prints entries with names C<foo>, and also entries
-with names which ends on C<bar>, or are shorter than 5 chars.
-
-=item set_quote
-
-  $d->set_quote('"');
-
-Sets C<tick> and C<unctrl> options to suitable values for printout with the
-given quote char.  Possible values are C<auto>, C<'> and C<">.
-
-=item set_unctrl
-
-  $d->set_unctrl('unctrl');
-
-Sets C<unctrl> option with checking for an invalid argument.
-Possible values are C<unctrl> and C<quote>.
-
-=item compactDump
-
-  $d->compactDump(1);
-
-Sets C<compactDump> option.  If the value is 1, sets to a reasonable
-big number.
-
-=item veryCompact
-
-  $d->veryCompact(1);
-
-Sets C<compactDump> and C<veryCompact> options simultaneously.
-
-=item set
-
-  $d->set(option1 => value1, option2 => value2);
-
-=item get
-
-  @values = $d->get('option1', 'option2');
-
-=back
-
-=cut
-
diff --git a/lib/Dumpvalue.t b/lib/Dumpvalue.t
deleted file mode 100644
index 6570e38a2e..0000000000
--- a/lib/Dumpvalue.t
+++ /dev/null
@@ -1,295 +0,0 @@
-#!./perl
-
-BEGIN {
-	chdir 't' if -d 't';
-	@INC = '../lib';
-	if (ord('A') == 193) {
-	    print "1..0 # skip: EBCDIC\n";
-	    exit 0;
-	}
-	require Config;
-	if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
-	    print "1..0 # Skip -- Perl configured without List::Util module\n";
-	    exit 0;
-	}
-}
-
-use vars qw( $foo @bar %baz );
-
-use Test::More tests => 88;
-
-use_ok( 'Dumpvalue' );
-
-my $d;
-ok( $d = Dumpvalue->new(), 'create a new Dumpvalue object' );
-
-$d->set( globPrint => 1, dumpReused => 1 );
-is( $d->{globPrint}, 1, 'set an option correctly' );
-is( $d->get('globPrint'), 1, 'get an option correctly' );
-is( $d->get('globPrint', 'dumpReused'), qw( 1 1 ), 'get multiple options' );
-
-# check to see if unctrl works
-is( ref( Dumpvalue::unctrl(*FOO) ), 'GLOB', 'unctrl should not modify GLOB' );
-is( Dumpvalue::unctrl('donotchange'), 'donotchange', "unctrl shouldn't modify");
-like( Dumpvalue::unctrl("bo\007nd"), qr/bo\^.nd/, 'unctrl should escape' );
-
-# check to see if stringify works
-is( $d->stringify(), 'undef', 'stringify handles undef okay' );
-
-# the default is 1, but we want two single quotes
-$d->{printUndef} = 0;
-is( $d->stringify(), "''", 'stringify skips undef when asked nicely' );
-
-is( $d->stringify(*FOO), *FOO . "", 'stringify stringifies globs alright' );
-
-# check for double-quotes if there's an unprintable character
-$d->{tick} = 'auto';
-like( $d->stringify("hi\005"), qr/^"hi/, 'added double-quotes when necessary' );
-
-# if no unprintable character, escape ticks or backslashes
-is( $d->stringify('hi'), "'hi'", 'used single-quotes when appropriate' );
-
-# if 'unctrl' is set
-$d->{unctrl} = 'unctrl';
-like( $d->stringify('double and whack:\ "'), qr!\\ \"!, 'escaped with unctrl' );
-like( $d->stringify("a\005"), qr/^"a\^/, 'escaped ASCII value in unctrl' );
-like( $d->stringify("b\205"), qr!^'b.'$!, 'no high-bit escape value in unctrl');
-
-$d->{quoteHighBit} = 1;
-like( $d->stringify("b\205"), qr!^'b\\205!, 'high-bit now escaped in unctrl');
-
-# if 'quote' is set
-$d->{unctrl} = 'quote';
-is( $d->stringify('5@ $1'), "'5\@ \$1'", 'quoted $ and @ fine' );
-is( $d->stringify("5@\033\$1"), '"5\@\e\$1"', 'quoted $ and @ and \033 fine' );
-like( $d->stringify("\037"), qr/^"\\c/, 'escaped ASCII value okay' );
-
-# add ticks, if necessary
-is( $d->stringify("no ticks", 1), 'no ticks', 'avoid ticks if asked' );
-
-my $out = tie *OUT, 'TieOut';
-select(OUT);
-
-# test DumpElem, it does its magic with veryCompact set
-$d->{veryCompact} = 1;
-$d->DumpElem([1, 2, 3]);
-is( $out->read, "0..2  1 2 3\n", 'DumpElem worked on array ref');
-$d->DumpElem({ one => 1, two => 2 });
-is( $out->read, "'one' => 1, 'two' => 2\n", 'DumpElem worked on hash ref' );
-$d->DumpElem('hi');
-is( $out->read, "'hi'\n", 'DumpElem worked on simple scalar' );
-$d->{veryCompact} = 0;
-$d->DumpElem([]);
-like( $out->read, qr/ARRAY/, 'DumpElem okay with reference and no veryCompact');
-
-# should compact simple arrays just fine
-$d->{veryCompact} = 1;
-$d->DumpElem([1, 2, 3]);
-is( $out->read, "0..2  1 2 3\n", 'dumped array fine' );
-$d->{arrayDepth} = 2;
-$d->DumpElem([1, 2, 3]);
-is( $out->read, "0..2  1 2 ...\n", 'dumped limited array fine' );
-
-# should compact simple hashes just fine
-$d->DumpElem({ a => 1, b => 2, c => 3 });
-is( $out->read, "'a' => 1, 'b' => 2, 'c' => 3\n", 'dumped hash fine' );
-$d->{hashDepth} = 2;
-$d->DumpElem({ a => 1, b => 2, c => 3 });
-is( $out->read, "'a' => 1, 'b' => 2 ...\n", 'dumped limited hash fine' );
-
-# should just stringify what it is
-$d->{veryCompact} = 0;
-$d->DumpElem([]);
-like( $out->read, qr/ARRAY.+empty array/s, 'stringified empty array ref' );
-$d->DumpElem({});
-like( $out->read, qr/HASH.+empty hash/s, 'stringified empty hash ref' );
-$d->DumpElem(1);
-is( $out->read, "1\n", 'stringified simple scalar' );
-
-# test unwrap
-$DB::signal = $d->{stopDbSignal} = 1;
-is( $d->unwrap(), undef, 'unwrap returns if DB signal is set' );
-undef $DB::signal;
-
-my $foo = 7;
-$d->{dumpReused} = 0;
-$d->unwrap(\$foo);
-is( $out->read, "-> 7\n", 'unwrap worked on scalar' );
-$d->unwrap(\$foo);
-is( $out->read, "-> REUSED_ADDRESS\n", 'unwrap worked on scalar' );
-$d->unwrap({ one => 1 });
-
-# leaving this at zero may cause some subsequent tests to fail
-# if they reuse an address creating an anonymous variable
-$d->{dumpReused} = 1;
-is( $out->read, "'one' => 1\n", 'unwrap worked on hash' );
-$d->unwrap([ 2, 3 ]);
-is( $out->read, "0  2\n1  3\n", 'unwrap worked on array' );
-$d->unwrap(*FOO);
-is( $out->read, '', 'unwrap ignored glob on first try');
-$d->unwrap(*FOO);
-is( $out->read, "*DUMPED_GLOB*\n", 'unwrap worked on glob');
-$d->unwrap(qr/foo(.+)/);
-is( $out->read, "-> qr/(?^:foo(.+))/\n", 'unwrap worked on Regexp' );
-$d->unwrap( sub {} );
-like( $out->read, qr/^-> &CODE/, 'unwrap worked on sub ref' );
-
-# test matchvar
-# test to see if first arg 'eq' second
-ok( Dumpvalue::matchvar(1, 1), 'matchvar matched numbers fine' );
-ok( Dumpvalue::matchvar('hi', 'hi'), 'matchvar matched strings fine' );
-ok( !Dumpvalue::matchvar('hello', 1), 'matchvar caught failed match fine' );
-
-# test compactDump, which doesn't do much
-is( $d->compactDump(3), 3, 'set compactDump to 3' );
-is( $d->compactDump(1), 479, 'compactDump reset to 6*80-1 when less than 2' );
-
-# test veryCompact, which does slightly more, setting compactDump sometimes
-$d->{compactDump} = 0;
-is( $d->veryCompact(1), 1, 'set veryCompact successfully' );
-ok( $d->compactDump(), 'and it set compactDump as well' );
-
-# test set_unctrl
-$d->set_unctrl('impossible value');
-like( $out->read, qr/^Unknown value/, 'set_unctrl caught bad value' );
-is( $d->set_unctrl('quote'), 'quote', 'set quote fine' );
-is( $d->set_unctrl(), 'quote', 'retrieved quote fine' );
-
-# test set_quote
-$d->set_quote('"');
-is( $d->{tick}, '"', 'set_quote set tick right' );
-is( $d->{unctrl}, 'quote', 'set unctrl right too' );
-$d->set_quote('auto');
-is( $d->{tick}, 'auto', 'set_quote set auto right' );
-$d->set_quote('foo');
-is( $d->{tick}, "'", 'default value set to " correctly' );
-
-# test dumpglob
-# should do nothing if debugger signal flag is raised
-$d->{stopDbSignal} = $DB::signal = 1;
-is( $d->dumpglob(*DB::signal), undef, 'returned early with DB signal set' );
-undef $DB::signal;
-
-# test dumping "normal" variables, this is a nasty glob trick
-$foo = 1;
-$d->dumpglob( '', 2, 'foo', local *foo = \$foo );
-is( $out->read, "  \$foo = 1\n", 'dumped glob for $foo correctly' );
-@bar = (1, 2);
-
-# the key name is a little different here
-$d->dumpglob( '', 0, 'boo', *bar );
-is( $out->read, "\@boo = (\n   0..1  1 2\n)\n", 'dumped glob for @bar fine' );
-
-%baz = ( one => 1, two => 2 );
-$d->dumpglob( '', 0, 'baz', *baz );
-is( $out->read, "\%baz = (\n   'one' => 1, 'two' => 2\n)\n",
-	'dumped glob for %baz fine' );
-
-SKIP: {
-	skip( "Couldn't open $0 for reading", 1 ) unless open(FILE, $0);
-	my $fileno = fileno(FILE);
-	$d->dumpglob( '', 0, 'FILE', *FILE );
-	is( $out->read, "FileHandle(FILE) => fileno($fileno)\n",
-		'dumped filehandle from glob fine' );
-}
-
-$d->dumpglob( '', 0, 'read', *TieOut::read );
-is( $out->read, '', 'no sub dumped without $all set' );
-$d->dumpglob( '', 0, 'read', \&TieOut::read, 1 );
-is( $out->read, "&read in ???\n", 'sub dumped when requested' );
-
-# see if it dumps DB-like values correctly
-$d->{dumpDBFiles} = 1;
-$d->dumpglob( '', 0, '_<foo', *foo );
-is( $out->read, "\$_<foo = 1\n", 'dumped glob for $_<foo correctly (DB)' );
-
-# test CvGV name
-SKIP: {
-	if (" $Config::Config{'extensions'} " !~ m[ Devel/Peek ]) {
-	    skip( 'no Devel::Peek', 2 );
-	}
-	use_ok( 'Devel::Peek' );
-	is( $d->CvGV_name(\&TieOut::read), 'TieOut::read', 'CvGV_name found sub' );
-}
-
-# test dumpsub
-$d->dumpsub( '', 'TieOut::read' );
-like( $out->read, qr/&TieOut::read in/, 'dumpsub found sub fine' );
-
-# test findsubs
-is( $d->findsubs(), undef, 'findsubs returns nothing without %DB::sub' );
-$DB::sub{'TieOut::read'} = 'TieOut';
-is( $d->findsubs( \&TieOut::read ), 'TieOut::read', 'findsubs reported sub' );
-
-# now that it's capable of finding the package...
-$d->dumpsub( '', 'TieOut::read' );
-is( $out->read, "&TieOut::read in TieOut\n", 'dumpsub found sub fine again' );
-
-# this should print just a usage message
-$d->{usageOnly} = 1;
-$d->dumpvars( 'Fake', 'veryfake' );
-like( $out->read, qr/^String space:/, 'printed usage message fine' );
-delete $d->{usageOnly};
-
-# this should report @INC and %INC
-$d->dumpvars( 'main', 'INC' );
-like( $out->read, qr/\@INC =/, 'dumped variables from a package' );
-
-# this should report nothing
-$DB::signal = 1;
-$d->dumpvars( 'main', 'INC' );
-is( $out->read, '', 'no dump when $DB::signal is set' );
-undef $DB::signal;
-
-is( $d->scalarUsage('12345'), 5, 'scalarUsage reports length correctly' );
-is( $d->arrayUsage( [1, 2, 3], 'a' ), 3, 'arrayUsage reports correct lengths' );
-is( $out->read, "\@a = 3 items (data: 3 bytes)\n", 'arrayUsage message okay' );
-is( $d->hashUsage({ one => 1 }, 'b'), 4, 'hashUsage reports correct lengths' );
-is( $out->read, "\%b = 1 item (keys: 3; values: 1; total: 4 bytes)\n",
-	'hashUsage message okay' );
-is( $d->hashUsage({ one => [ 1, 2, 3 ]}, 'c'), 6, 'complex hash okay' );
-is( $out->read, "\%c = 1 item (keys: 3; values: 3; total: 6 bytes)\n",
-	'hashUsage complex message okay' );
-
-$foo = 'one';
-@foo = ('two');
-%foo = ( three => '123' );
-is( $d->globUsage(\*foo, 'foo'), 14, 'globUsage reports length correctly' );
-like( $out->read, qr/\@foo =.+\%foo =/s, 'globValue message okay' );
-
-# and now, the real show
-$d->dumpValue(undef);
-is( $out->read, "undef\n", 'dumpValue caught undef value okay' );
-$d->dumpValue($foo);
-is( $out->read, "'one'\n", 'dumpValue worked' );
-$d->dumpValue(@foo);
-is( $out->read, "'two'\n", 'dumpValue worked on array' );
-$d->dumpValue(\$foo);
-is( $out->read, "-> 'one'\n", 'dumpValue worked on scalar ref' );
-
-# dumpValues (the rest of these should be caught by unwrap)
-$d->dumpValues(undef);
-is( $out->read, "undef\n", 'dumpValues caught undef value fine' );
-$d->dumpValues(\@foo);
-is( $out->read, "0  0..0  'two'\n", 'dumpValues worked on array ref' );
-$d->dumpValues('one', 'two');
-is( $out->read, "0..1  'one' 'two'\n", 'dumpValues worked on multiple values' );
-
-
-package TieOut;
-use overload '"' => sub { "overloaded!" };
-
-sub TIEHANDLE {
-	my $class = shift;
-	bless(\( my $ref), $class);
-}
-
-sub PRINT {
-	my $self = shift;
-	$$self .= join('', @_);
-}
-
-sub read {
-	my $self = shift;
-	return substr($$self, 0, length($$self), '');
-}