ripples from constsub patch

Message-Id: <m13nSOB-000FObC@feynman.localnet>

p4raw-id: //depot/perl@7403

diff --git a/dump.c b/dump.c
index ad0a21f..cffbc44 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -822,6 +822,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (CvUNIQUE(sv))       sv_catpv(d, "UNIQUE,");
        if (CvCLONE(sv))        sv_catpv(d, "CLONE,");
        if (CvCLONED(sv))       sv_catpv(d, "CLONED,");
+       if (CvCONST(sv))        sv_catpv(d, "CONST,");
        if (CvNODEBUG(sv))      sv_catpv(d, "NODEBUG,");
        if (SvCOMPILED(sv))     sv_catpv(d, "COMPILED,");
        break;

diff --git a/ext/B/B.pm b/ext/B/B.pm
index dc4c4f7..70c424b 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -531,6 +531,8 @@ This method returns TRUE if the GP field of the GV is NULL.
 
 =item CvFLAGS
 
+=item const_sv
+
 =back
 
 =head2 B::HV METHODS

diff --git a/ext/B/B.xs b/ext/B/B.xs
index f1f0e65..ec9e578 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1229,6 +1229,12 @@ U16
 CvFLAGS(cv)
       B::CV   cv
 
+MODULE = B     PACKAGE = B::CV         PREFIX = cv_
+
+B::SV
+cv_const_sv(cv)
+       B::CV   cv
+
 
 MODULE = B     PACKAGE = B::HV         PREFIX = Hv
 

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 5c5c5eb..7d16752 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -446,6 +446,11 @@ sub deparse_sub {
        # skip leavesub
        return $proto . "{\n\t" . 
            $self->deparse($cv->ROOT->first, 0) . "\n\b}\n"; 
+    }
+    my $sv = $cv->const_sv;
+    if ($$sv) {
+       # uh-oh. inlinable sub... format it differently
+       return $proto . "{ " . const($sv) . " }\n";
     } else { # XSUB?
        return $proto  . "{}\n";
     }

diff --git a/t/lib/b.t b/t/lib/b.t
index 2be4d10..6303d62 100755 (executable)
--- a/t/lib/b.t
+++ b/t/lib/b.t
@@ -10,7 +10,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..13\n";
+print "1..15\n";
 
 my $test = 1;
 
@@ -53,6 +53,20 @@ print "not " if $deparse->coderef2text(sub{$test = sub : method locked { 1 }})
 ok;
 }
 
+print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
+ok;
+
+use constant 'c', 'stuff';
+print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
+ok;
+
+# XXX ToDo - constsub that returns a reference
+#use constant cr => ['hello'];
+#my $string = "sub " . $deparse->coderef2text(\&cr);
+#my $val = (eval $string)->();
+#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
+#ok;
+
 my $a;
 my $Is_VMS = $^O eq 'VMS';
 $a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
@@ -72,13 +86,11 @@ EOF
 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
 ok;
 
-#6
 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
 print "not " unless $a =~
 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
 ok;
 
-#7
 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
 print "not " unless $a =~
 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;