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!).

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index fbc0fd8..eaf5bd4 100755 (executable)
--- 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";
                }