perl 5.003_07: lib/ExtUtils/xsubpp

Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>

Logic for processing RETVAL documented (at last!).

1 files changed, 17 insertions, 5 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index fbc0fd89d6..eaf5bd4342 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -1232,15 +1232,27 @@ sub generate_output {
 		eval "print qq\a$expr\a";
 	    }
 	    elsif ($var eq 'RETVAL') {
-		if ($expr =~ /^\t\$arg\s*=\s*\$var\s*;/) {
-		    eval "print qq\a$expr\a";
-		    print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
-		} 
-		elsif ($expr =~ /^\t\$arg = /) {
+		if ($expr =~ /^\t\$arg = new/) {
+		    # We expect that $arg has refcnt 1, so we need to
+		    # mortalize it.
 		    eval "print qq\a$expr\a";
 		    print "\tsv_2mortal(ST(0));\n";
 		}
+		elsif ($expr =~ /^\s*\$arg\s*=/) {
+		    # We expect that $arg has refcnt >=1, so we need
+		    # to mortalize it. However, the extension may have
+		    # returned the built-in perl value, which is
+		    # read-only, thus not mortalizable. However, it is
+		    # safe to leave it as it is, since it would be
+		    # ignored by REFCNT_dec. Builtin values have REFCNT==0.
+		    eval "print qq\a$expr\a";
+		    print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
+		}
 		else {
+		    # Just hope that the entry would safely write it
+		    # over an already mortalized value. By
+		    # coincidence, something like $arg = &sv_undef
+		    # works too.
 		    print "\tST(0) = sv_newmortal();\n";
 		    eval "print qq\a$expr\a";
 		}