make xsubpp generate well-formed code with CAPI && !PERL_OBJECT

[p5sagit/p5-mst-13.2.git] / lib / dumpvar.pl

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 06c0930..32d4692 100644 (file)
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -22,9 +22,12 @@ $printUndef = 1 unless defined $printUndef;
 $tick = "auto" unless defined $tick;
 $unctrl = 'quote' unless defined $unctrl;
 $subdump = 1;
+$dumpReused = 0 unless defined $dumpReused;
+$bareStringify = 1 unless defined $bareStringify;
 
 sub main::dumpValue {
   local %address;
+  local $^W=0;
   (print "undef\n"), return unless defined $_[0];
   (print &stringify($_[0]), "\n"), return unless ref $_[0];
   dumpvar::unwrap($_[0],0);
@@ -48,6 +51,10 @@ sub stringify {
 
        return 'undef' unless defined $_ or not $printUndef;
        return $_ . "" if ref \$_ eq 'GLOB';
+       $_ = &{'overload::StrVal'}($_) 
+         if $bareStringify and ref $_ 
+           and defined %overload:: and defined &{'overload::StrVal'};
+       
        if ($tick eq 'auto') {
          if (/[\000-\011\013-\037\177]/) {
            $tick = '"';
@@ -108,7 +115,7 @@ sub unwrap {
     return if $DB::signal;
     local($v) = shift ; 
     local($s) = shift ; # extra no of spaces
-    local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ;
+    local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ;
     local($tHashDepth,$tArrayDepth) ;
 
     $sp = " " x $s ;
@@ -116,9 +123,11 @@ sub unwrap {
 
     # Check for reused addresses
     if (ref $v) { 
-      ($address) = $v =~ /(0x[0-9a-f]+)/ ; 
-      if (defined $address) { 
-       ($type) = $v =~ /=(.*?)\(/ ;
+      my $val = $v;
+      $val = &{'overload::StrVal'}($v) 
+       if defined %overload:: and defined &{'overload::StrVal'};
+      ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; 
+      if (!$dumpReused && defined $address) { 
        $address{$address}++ ;
        if ( $address{$address} > 1 ) { 
          print "${sp}-> REUSED_ADDRESS\n" ; 
@@ -134,7 +143,7 @@ sub unwrap {
       } 
     }
 
-    if ( ref $v eq 'HASH' or $type eq 'HASH') { 
+    if ( UNIVERSAL::isa($v, 'HASH') ) { 
        @sortKeys = sort keys(%$v) ;
        undef $more ; 
        $tHashDepth = $#sortKeys ; 
@@ -167,7 +176,7 @@ sub unwrap {
        }
        print "$sp  empty hash\n" unless @sortKeys;
        print "$sp$more" if defined $more ;
-    } elsif ( ref $v eq 'ARRAY' or $type eq 'ARRAY') { 
+    } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) { 
        $tArrayDepth = $#{$v} ; 
        undef $more ; 
        $tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 
@@ -197,13 +206,13 @@ sub unwrap {
        }
        print "$sp  empty array\n" unless @$v;
        print "$sp$more" if defined $more ;  
-    } elsif ( ref $v eq 'SCALAR' or ref $v eq 'REF' or $type eq 'SCALAR' ) { 
+    } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { 
            print "$sp-> ";
            DumpElem $$v, $s;
-    } elsif ( ref $v eq 'CODE' or $type eq 'CODE' ) { 
+    } elsif ( UNIVERSAL::isa($v, 'CODE') ) { 
            print "$sp-> ";
            dumpsub (0, $v);
-    } elsif (ref $v eq 'GLOB') {
+    } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
       print "$sp-> ",&stringify($$v,1),"\n";
       if ($globPrint) {
        $s += 3;
@@ -222,8 +231,8 @@ sub unwrap {
 
 sub matchvar {
   $_[0] eq $_[1] or 
-    ($_[1] =~ /^([!~])(.)/) and 
-      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$'/});
+    ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and 
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
 }
 
 sub compactDump {
@@ -319,7 +328,7 @@ sub findsubs {
 
 sub main::dumpvar {
     my ($package,@vars) = @_;
-    local(%address,$key,$val);
+    local(%address,$key,$val,$^W);
     $package .= "::" unless $package =~ /::$/;
     *stab = *{"main::"};
     while ($package =~ /(\w+?::)/g){