This may significantly slow down the generated code, but this is the way
B<xsubpp> of 5.005 and earlier operated.
+=item B<-noinout>
+
+Disable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST> declarations.
+
+=item B<-noargtypes>
+
+Disable recognition of ANSI-like descriptions of function signature.
+
=back
=head1 ENVIRONMENT
$FH = 'File0000' ;
-$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-s pattern] [-typemap typemap]... file.xs\n";
+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
# mjn
$ProtoUsed = 0 ;
$WantLineNumbers = 1 ;
$WantOptimize = 1 ;
+
+my $process_inout = 1;
+my $process_argtypes = 1;
+
SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
$flag = shift @ARGV;
$flag =~ s/^-// ;
$WantLineNumbers = 1, next SWITCH if $flag eq 'linenumbers';
$WantOptimize = 0, next SWITCH if $flag eq 'nooptimize';
$WantOptimize = 1, next SWITCH if $flag eq 'optimize';
+ $process_inout = 0, next SWITCH if $flag eq 'noinout';
+ $process_inout = 1, next SWITCH if $flag eq 'inout';
+ $process_argtypes = 0, next SWITCH if $flag eq 'noargtypes';
+ $process_argtypes = 1, next SWITCH if $flag eq 'argtypes';
(print "xsubpp version $XSUBPP_version\n"), exit
if $flag eq 'v';
die $usage;
# Match an XS keyword
$BLOCK_re= '\s*(' . join('|', qw(
REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
- CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+ CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
)) . "|$END)\\s*:";
$_ = '' ;
}
-my $process_inout = 1;
-my $process_argtypes = 1;
-
sub INPUT_handler {
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
last if /^\s*NOT_IMPLEMENTED_YET/;
if $line ;
}
+sub ATTRS_handler ()
+{
+ for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ next unless /\S/;
+ TrimWhitespace($_) ;
+ push @Attributes, $_;
+ }
+}
+
sub ALIAS_handler ()
{
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
print("#line 1 \"$filename\"\n")
if $WantLineNumbers;
+firstmodule:
while (<$FH>) {
+ if (/^=/) {
+ do {
+ next firstmodule if /^=cut\s*$/;
+ } while (<$FH>);
+ &Exit;
+ }
last if ($Module, $Package, $Prefix) =
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
}
for(;;) {
+ # Skip embedded PODs
+ while ($lastline =~ /^=/) {
+ while ($lastline = <$FH>) {
+ last if ($lastline =~ /^=cut\s*$/);
+ }
+ death ("Error: Unterminated pod") unless $lastline;
+ $lastline = <$FH>;
+ chomp $lastline;
+ $lastline =~ s/^\s+$//;
+ }
if ($lastline !~ /^\s*#/ ||
# CPP directives:
# ANSI: if ifdef ifndef elif else endif define undef
($ret_type) = TidyType($_);
$RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//;
+ # Allow one-line ANSI-like declaration
+ unshift @line, $2
+ if $process_argtypes
+ and $ret_type =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s;
+
# a function definition needs at least 2 lines
blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
unless @line ;
last;
}
$XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
- %XsubAliases = %XsubAliasValues = %Interfaces = ();
+ %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
$DoSetMagic = 1;
$orig_args =~ s/\\\s*/ /g; # process line continuations
$gotRETVAL = 0;
INPUT_handler() ;
- process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ;
+ process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ;
print Q<<"EOF" if $ScopeThisXSUB;
# ENTER;
}
print $deferred;
- process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
+ process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
if (check_keyword("PPCODE")) {
print_section();
# $wantRETVAL set if 'RETVAL =' autogenerated
($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
undef %outargs ;
- process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE");
+ process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE");
# all OUTPUT done, so now push the return value on the stack
if ($gotRETVAL && $RETVAL_code) {
generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out;
# do cleanup
- process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
+ process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ;
print Q<<"EOF" if $ScopeThisXSUB;
# ]]
EOF
}
}
+ elsif (@Attributes) {
+ push(@InitFileCode, Q<<"EOF");
+# cv = newXS(\"$pname\", XS_$Full_func_name, file);
+# apply_attrs_string("$Package", cv, "@Attributes", 0);
+EOF
+ }
elsif ($interface) {
while ( ($name, $value) = each %Interfaces) {
$name = "$Package\::$name" unless $name =~ /::/;
unless defined($type_kind{$type});
($ntype = $type) =~ s/\s*\*/Ptr/g;
- $ntype =~ s/^\s*const\b\s*//;
($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
$tk = $type_kind{$type};
$tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;