perl 5.003_04: lib/ExtUtils/xsubpp

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

1 files changed, 43 insertions, 4 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 13f54b4855..f2f10d797b 100755
--- 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 {