diff options
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 37 | ||||
| -rw-r--r-- | pod/perlxs.pod | 32 |
2 files changed, 56 insertions, 13 deletions
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 774ba79345..484b5778f8 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -86,6 +86,7 @@ perl(1), perlxs(1), perlxstut(1) require 5.002; use Cwd; use vars '$cplusplus'; +use vars '%v'; use Config; @@ -351,11 +352,11 @@ sub INPUT_handler { my $line = $_ ; # remove trailing semicolon if no initialisation - s/\s*;$//g unless /=/ ; + s/\s*;$//g unless /[=;+].*\S/ ; # check for optional initialisation code my $var_init = '' ; - $var_init = $1 if s/\s*(=.*)$//s ; + $var_init = $1 if s/\s*([=;+].*)$//s ; $var_init =~ s/"/\\"/g; s/\s+/ /g; @@ -378,10 +379,10 @@ sub INPUT_handler { $var_addr{$var_name} = 1; $func_args =~ s/\b($var_name)\b/&$1/; } - if ($var_init =~ /^=\s*NO_INIT\s*;?\s*$/) { + if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/) { print "\t$var_name;\n"; } elsif ($var_init =~ /\S/) { - &output_init($var_type, $var_num, "$var_name $var_init"); + &output_init($var_type, $var_num, $var_name, $var_init); } elsif ($var_num) { # generate initialization code &generate_init($var_type, $var_num, $var_name); @@ -1331,12 +1332,24 @@ warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") unless $ProtoUsed ; &Exit; - sub output_init { - local($type, $num, $init) = @_; + local($type, $num, $var, $init) = @_; local($arg) = "ST(" . ($num - 1) . ")"; - eval qq/print " $init\\\n"/; + if( $init =~ /^=/ ) { + eval qq/print "\\t$var $init\\n"/; + warn $@ if $@; + } else { + if( $init =~ s/^\+// && $num ) { + &generate_init($type, $num, $var); + } else { + eval qq/print "\\t$var;\\n"/; + warn $@ if $@; + $init =~ s/^;//; + } + $deferred .= eval qq/"\\n\\t$init\\n"/; + warn $@ if $@; + } } sub Warn @@ -1398,12 +1411,17 @@ sub generate_init { $expr =~ s/(\t+)/$1 /g; $expr =~ s/ /\t/g; eval qq/print "\\t$var;\\n"/; + warn $@ if $@; $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; + warn $@ if $@; } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) { eval qq/print "\\t$var;\\n"/; + warn $@ if $@; $deferred .= eval qq/"\\n$expr;\\n"/; + warn $@ if $@; } else { eval qq/print "$expr;\\n"/; + warn $@ if $@; } } @@ -1438,6 +1456,7 @@ sub generate_output { $subexpr =~ s/\n\t/\n\t\t/g; $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/; eval "print qq\a$expr\a"; + warn $@ if $@; print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic; } elsif ($var eq 'RETVAL') { @@ -1445,6 +1464,7 @@ sub generate_output { # We expect that $arg has refcnt 1, so we need to # mortalize it. eval "print qq\a$expr\a"; + warn $@ if $@; print "\tsv_2mortal(ST(0));\n"; print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; } @@ -1452,6 +1472,7 @@ sub generate_output { # We expect that $arg has refcnt >=1, so we need # to mortalize it! eval "print qq\a$expr\a"; + warn $@ if $@; print "\tsv_2mortal(ST(0));\n"; print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; } @@ -1462,11 +1483,13 @@ sub generate_output { # works too. print "\tST(0) = sv_newmortal();\n"; eval "print qq\a$expr\a"; + warn $@ if $@; # new mortals don't have set magic } } elsif ($arg =~ /^ST\(\d+\)$/) { eval "print qq\a$expr\a"; + warn $@ if $@; print "\tSvSETMAGIC($arg);\n" if $do_setmagic; } } diff --git a/pod/perlxs.pod b/pod/perlxs.pod index c4a064d957..1eea753c61 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -360,17 +360,19 @@ Function parameters are normally initialized with their values from the argument stack. The typemaps contain the code segments which are used to transfer the Perl values to the C parameters. The programmer, however, is allowed to -override the typemaps and supply alternate initialization -code. +override the typemaps and supply alternate (or additional) +initialization code. The following code demonstrates how to supply initialization code for -function parameters. The initialization code is eval'd by the compiler -before it is added to the output so anything which should be interpreted -literally, such as double quotes, must be protected with backslashes. +function parameters. The initialization code is eval'd within double +quotes by the compiler before it is added to the output so anything +which should be interpreted literally [mainly C<$>, C<@>, or C<\\>] +must be protected with backslashes. The variables C<$var>, C<$arg>, +and C<$type> can be used as in typemaps. bool_t rpcb_gettime(host,timep) - char *host = (char *)SvPV(ST(0),na); + char *host = (char *)SvPV($arg,na); time_t &timep = 0; OUTPUT: timep @@ -380,6 +382,24 @@ would normally use this when a function parameter must be processed by another library function before it can be used. Default parameters are covered in the next section. +If the initialization begins with C<=>, then it is output on +the same line where the input variable is declared. If the +initialization begins with C<;> or C<+>, then it is output after +all of the input variables have been declared. The C<=> and C<;> +cases replace the initialization normally supplied from the typemap. +For the C<+> case, the initialization from the typemap will preceed +the initialization code included after the C<+>. A global +variable, C<%v>, is available for the truely rare case where +information from one initialization is needed in another +initialization. + + bool_t + rpcb_gettime(host,timep) + time_t &timep ; /*\$v{time}=@{[$v{time}=$arg]}*/ + char *host + SvOK($v{time}) ? SvPV($arg,na) : NULL; + OUTPUT: + timep + =head2 Default Parameter Values Default values can be specified for function parameters by |