diff options
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 47 |
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 { |