perl 5.003_04: lib/ExtUtils/xsubpp

Fix SCOPE?  (See pod/perlxs.pod).
Up version number to 1.938.

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 13f54b4..f2f10d7 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -76,7 +76,7 @@ perl(1), perlxs(1), perlxstut(1), perlapi(1)
 =cut
 
 # Global Constants
-$XSUBPP_version = "1.937";
+$XSUBPP_version = "1.938";
 require 5.002;
 use vars '$cplusplus';
 
@@ -215,6 +215,7 @@ $END = "!End!\n\n";         # "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
        REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
        CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+       SCOPE
        )) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -440,6 +441,24 @@ sub PROTOTYPE_handler ()
 
 }
 
+sub SCOPE_handler ()
+{
+    death("Error: Only 1 SCOPE declaration allowed per xsub") 
+        if $scope_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+               next unless /\S/;
+               TrimWhitespace($_) ;
+        if ($_ =~ /^DISABLE/i) {
+                  $ScopeThisXSUB = 0 
+        }
+        elsif ($_ =~ /^ENABLE/i) {
+                  $ScopeThisXSUB = 1 
+        }
+    }
+
+}
+
 sub PROTOTYPES_handler ()
 {
     # the rest of the current line should contain either ENABLE or
@@ -737,7 +756,9 @@ while (fetch_para()) {
     undef(%arg_list) ;
     undef(@proto_arg) ;
     undef($proto_in_this_xsub) ;
+    undef($scope_in_this_xsub) ;
     $ProtoThisXSUB = $WantPrototypes ;
+    $ScopeThisXSUB = 0;
 
     $_ = shift(@line);
     while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
@@ -876,8 +897,13 @@ EOF
         $gotRETVAL = 0;
 
        INPUT_handler() ;
-       process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE") ;
+       process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE|SCOPE") ;
 
+       print Q<<"EOF" if $ScopeThisXSUB;
+#   ENTER;
+#   [[
+EOF
+       
        if (!$thisdone && defined($class)) {
            if (defined($static) or $func_name =~ /^new/) {
                print "\tchar *";
@@ -902,12 +928,15 @@ EOF
                        $args_match{"RETVAL"} = 0;
                        $var_types{"RETVAL"} = $ret_type;
                }
+
                print $deferred;
-                process_keyword("INIT|ALIAS|PROTOTYPE") ;
+
+        process_keyword("INIT|ALIAS|PROTOTYPE") ;
 
                if (check_keyword("PPCODE")) {
                        print_section();
                        death ("PPCODE must be last thing") if @line;
+                       print "\tLEAVE;\n" if $ScopeThisXSUB;
                        print "\tPUTBACK;\n\treturn;\n";
                } elsif (check_keyword("CODE")) {
                        print_section() ;
@@ -955,6 +984,13 @@ EOF
        # do cleanup
        process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
 
+       print Q<<"EOF" if $ScopeThisXSUB;
+#   ]]
+EOF
+       print Q<<"EOF" if $ScopeThisXSUB and not $PPCODE;
+#   LEAVE;
+EOF
+
        # print function trailer
        print Q<<EOF;
 #    ]]
@@ -1148,12 +1184,15 @@ sub generate_init {
        $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
        $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
     }
+    if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
+       $ScopeThisXSUB = 1;
+    }
     if (defined($defaults{$var})) {
            $expr =~ s/(\t+)/$1    /g;
            $expr =~ s/        /\t/g;
            eval qq/print "\\t$var;\\n"/;
            $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
-    } elsif ($expr !~ /^\t\$var =/) {
+    } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) {
            eval qq/print "\\t$var;\\n"/;
            $deferred .= eval qq/"\\n$expr;\\n"/;
     } else {