From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 29 Mar 2009 19:03:18 +0000 (+0100)
Subject: Change Perl_newCONSTSUB() so that a NULL sv generates an empty list return.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=99ab892b6470bcd28bad5512a942b608496ebf8f;p=p5sagit%2Fp5-mst-13.2.git

Change Perl_newCONSTSUB() so that a NULL sv generates an empty list return.
Don't call DESTROY if it's a constant subroutine.
---

diff --git a/embed.fnc b/embed.fnc
index 395bc23..27dd26a 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -646,7 +646,7 @@ Apa	|OP*	|newANONHASH	|NULLOK OP* o
 Ap	|OP*	|newANONSUB	|I32 floor|NULLOK OP* proto|NULLOK OP* block
 Apa	|OP*	|newASSIGNOP	|I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right
 Apa	|OP*	|newCONDOP	|I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop
-Apd	|CV*	|newCONSTSUB	|NULLOK HV* stash|NULLOK const char* name|NN SV* sv
+Apd	|CV*	|newCONSTSUB	|NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv
 #ifdef PERL_MAD
 Ap	|OP*	|newFORM	|I32 floor|NULLOK OP* o|NULLOK OP* block
 #else
diff --git a/op.c b/op.c
index 78d9990..b889319 100644
--- a/op.c
+++ b/op.c
@@ -5949,6 +5949,11 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
 Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
 eligible for inlining at compile-time.
 
+Passing NULL for SV creates a constant sub equivalent to C<sub BAR () {}>,
+which won't be called if used as a destructor, but will suppress the overhead
+of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
+compile time.)
+
 =cut
 */
 
@@ -8968,6 +8973,7 @@ const_sv_xsub(pTHX_ CV* cv)
 {
     dVAR;
     dXSARGS;
+    SV *const sv = MUTABLE_SV(XSANY.any_ptr);
     if (items != 0) {
 	NOOP;
 #if 0
@@ -8975,8 +8981,11 @@ const_sv_xsub(pTHX_ CV* cv)
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
+    if (!sv) {
+	XSRETURN(0);
+    }
     EXTEND(sp, 1);
-    ST(0) = MUTABLE_SV(XSANY.any_ptr);
+    ST(0) = sv;
     XSRETURN(1);
 }
 
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index fc51e14..0687604 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -3091,6 +3091,11 @@ X<newCONSTSUB>
 Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
 eligible for inlining at compile-time.
 
+Passing NULL for SV creates a constant sub equivalent to C<sub BAR () {}>,
+which won't be called if used as a destructor, but will suppress the overhead
+of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
+compile time.)
+
 	CV*	newCONSTSUB(HV* stash, const char* name, SV* sv)
 
 =for hackers
diff --git a/proto.h b/proto.h
index 1c132db..552b9f6 100644
--- a/proto.h
+++ b/proto.h
@@ -1992,11 +1992,7 @@ PERL_CALLCONV OP*	Perl_newCONDOP(pTHX_ I32 flags, OP* first, OP* trueop, OP* fal
 #define PERL_ARGS_ASSERT_NEWCONDOP	\
 	assert(first)
 
-PERL_CALLCONV CV*	Perl_newCONSTSUB(pTHX_ HV* stash, const char* name, SV* sv)
-			__attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_NEWCONSTSUB	\
-	assert(sv)
-
+PERL_CALLCONV CV*	Perl_newCONSTSUB(pTHX_ HV* stash, const char* name, SV* sv);
 #ifdef PERL_MAD
 PERL_CALLCONV OP*	Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block);
 #else
diff --git a/sv.c b/sv.c
index 912f517..12ca453 100644
--- a/sv.c
+++ b/sv.c
@@ -5656,6 +5656,9 @@ Perl_sv_clear(pTHX_ register SV *const sv)
 		stash = SvSTASH(sv);
 		destructor = StashHANDLER(stash,DESTROY);
 		if (destructor
+			/* A constant subroutine can have no side effects, so
+			   don't bother calling it.  */
+			&& !CvCONST(destructor)
 			/* Don't bother calling an empty destructor */
 			&& (CvISXSUB(destructor)
 			|| CvSTART(destructor)->op_next->op_type != OP_LEAVESUB))