ripples from constsub patch

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

p4raw-id: //depot/perl@7403

5 files changed, 29 insertions, 3 deletions

diff --git a/dump.c b/dump.c
index ad0a21f1aa..cffbc4498a 100644
--- 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 dc4c4f7417..70c424ba1a 100644
--- 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 f1f0e65781..ec9e578020 100644
--- 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 5c5c5eb9cb..7d1675290b 100644
--- 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 2be4d10bf8..6303d624ed 100755
--- 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;