cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm converts Perl XS code into C code
cpan/ExtUtils-ParseXS/lib/ExtUtils/xsubpp External subroutine preprocessor
cpan/ExtUtils-ParseXS/t/basic.t See if ExtUtils::ParseXS works
+cpan/ExtUtils-ParseXS/t/more.t Extended ExtUtils::ParseXS testing
+cpan/ExtUtils-ParseXS/t/typemap Standard typemap for controlled testing
cpan/ExtUtils-ParseXS/t/usage.t ExtUtils::ParseXS tests
+cpan/ExtUtils-ParseXS/t/XSInclude.xsh Test file for ExtUtils::ParseXS tests
+cpan/ExtUtils-ParseXS/t/XSMore.xs Test file for ExtUtils::ParseXS tests
cpan/ExtUtils-ParseXS/t/XSTest.pm Test file for ExtUtils::ParseXS tests
cpan/ExtUtils-ParseXS/t/XSTest.xs Test file for ExtUtils::ParseXS tests
cpan/ExtUtils-ParseXS/t/XSUsage.pm ExtUtils::ParseXS tests
'ExtUtils::ParseXS' =>
{
'MAINTAINER' => 'kwilliams',
- 'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-ParseXS-2.200403.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-ParseXS-2.21.tar.gz',
'FILES' => q[cpan/ExtUtils-ParseXS],
'CPAN' => 1,
'UPSTREAM' => 'cpan',
Revision history for Perl extension ExtUtils::ParseXS.
+2.21 - Mon Oct 5 11:17:53 EDT 2009
+
+ Bug fixes:
+ - Adds full path in INCLUDE #line directives (RT#50198) [patch by "spb"]
+
+ Other:
+ - Updated copyright and maintainer list
+
+2.20_07 - Sat Oct 3 11:26:55 EDT 2009
+
+ Bug fixes:
+ - Use "char* file" for perl < 5.9, not "char[] file"; fixes mod_perl
+ breakage due to prior attempts to fix RT#48104 [David Golden]
+
+2.20_06 - Fri Oct 2 23:45:45 EDT 2009
+
+ Bug fixes:
+ - Added t/typemap to fix broken test on perl 5.6.2 [David Golden]
+ - More prototype fixes for older perls [Goro Fuji]
+ - Avoid "const char *" in test files as it breaks on 5.6.2 [Goro Fuji]
+
+ Other:
+ - Merged changes from 2.2004 maintenance branch (see 2.200401 to 2.200403)
+ [David Golden]
+
+2.20_05 - Sat Aug 22 21:46:56 EDT 2009
+
+ Bug fixes:
+ - Fix prototype related bugs [Goro Fuji]
+ - Fix the SCOPE keyword [Goro Fuji]
+
2.200403 - Fri Oct 2 02:01:58 EDT 2009
Other:
- No changes from 2.20_04.
+
2.20_04 - Mon Aug 10 11:18:47 EDT 2009
Bug fixes:
2.20_03 - Thu Jul 23 23:14:50 EDT 2009
Bug fixes:
- - Fixed "const char *" errors for 5.8.8 (and older) (RT#48104)
- [Vincent Pit]
+ - Fixed "const char *" errors for 5.8.8 (and older) (RT#48104)
+ [Vincent Pit]
- Added newline before a preprocessor directive (RT#30673)
[patch by hjp]
my($XSS_work_idx, $cpp_next_tmp);
use vars qw($VERSION);
-$VERSION = '2.200403';
+$VERSION = '2.21';
+$VERSION = eval $VERSION if $VERSION =~ /_/;
use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
$cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
$size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
foreach my $key (keys %output_expr) {
- # We can still bootstrap compile 're', because in code re.pm is
+ # We can still bootstrap compile 're', because in code re.pm is
# available to miniperl, and does not attempt to load the XS code.
use re 'eval';
#endif
+/* NOTE: the prototype of newXSproto() is different in versions of perls,
+ * so we define a portable version of newXSproto()
+ */
+#ifdef newXS_flags
+#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
+#else
+#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
+#endif /* !defined(newXS_flags) */
+
EOF
print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
$xsreturn = 0;
$_ = shift(@line);
- while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE")) {
+ while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE|SCOPE")) {
&{"${kwd}_handler"}() ;
next PARAGRAPH unless @line ;
$_ = shift(@line);
next;
}
last if $_ eq "$END:";
- death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
+ death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function ($_)");
}
print Q(<<"EOF") if $except;
#
EOF
- my $newXS = "newXS" ;
- my $proto = "" ;
+ our $newXS = "newXS" ;
+ our $proto = "" ;
# Build the prototype string for the xsub
if ($ProtoThisXSUB) {
- $newXS = "newXSproto";
+ $newXS = "newXSproto_portable";
if ($ProtoThisXSUB eq 2) {
# User has specified empty prototype
}
$proto = qq{, "$proto"};
}
-
+
if (%XsubAliases) {
$XsubAliases{$pname} = 0
unless defined $XsubAliases{$pname} ;
while ( ($name, $value) = each %XsubAliases) {
push(@InitFileCode, Q(<<"EOF"));
-# cv = newXS(\"$name\", XS_$Full_func_name, file);
+# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
# XSANY.any_i32 = $value ;
EOF
- push(@InitFileCode, Q(<<"EOF")) if $proto;
-# sv_setpv((SV*)cv$proto) ;
-EOF
}
}
elsif (@Attributes) {
push(@InitFileCode, Q(<<"EOF"));
-# cv = newXS(\"$pname\", XS_$Full_func_name, file);
+# cv = ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);
# apply_attrs_string("$Package", cv, "@Attributes", 0);
EOF
}
while ( ($name, $value) = each %Interfaces) {
$name = "$Package\::$name" unless $name =~ /::/;
push(@InitFileCode, Q(<<"EOF"));
-# cv = newXS(\"$name\", XS_$Full_func_name, file);
+# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
# $interface_macro_set(cv,$value) ;
EOF
- push(@InitFileCode, Q(<<"EOF")) if $proto;
-# sv_setpv((SV*)cv$proto) ;
-EOF
}
}
else {
push(@InitFileCode,
- " ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+ " (void)${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
}
}
/* Making a sub named "${Package}::()" allows the package */
/* to be findable via fetchmethod(), and causes */
/* overload::Overloaded("${Package}") to return true. */
- newXS("${Package}::()", XS_${Packid}_nil, file$proto);
+ (void)${newXS}("${Package}::()", XS_${Packid}_nil, file$proto);
MAKE_FETCHMETHOD_WORK
}
#so `file' is unused
print Q(<<"EOF") if $Full_func_name;
##if (PERL_REVISION == 5 && PERL_VERSION < 9)
-# char file[] = __FILE__;
+# char* file = __FILE__;
##else
# const char* file = __FILE__;
##endif
$Overload = 1 unless $Overload;
my $overload = "$Package\::(".$1 ;
push(@InitFileCode,
- " newXS(\"$overload\", XS_$Full_func_name, file$proto);\n");
+ " (void)${newXS}(\"$overload\", XS_$Full_func_name, file$proto);\n");
}
}
}
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
- }
- }
-
+ TrimWhitespace($_);
+ death ("Error: SCOPE: ENABLE/DISABLE")
+ unless /^(ENABLE|DISABLE)\b/i;
+ $ScopeThisXSUB = ( uc($1) eq 'ENABLE' );
}
sub PROTOTYPES_handler ()
#
EOF
- $filepathname = $filename = $_ ;
+ $filename = $_ ;
+ $filepathname = "$dir/$filename";
# Prime the pump by reading the first
# non-blank line
Based on xsubpp code, written by Larry Wall.
-Maintained by Ken Williams, <ken@mathforum.org>
+Maintained by:
+
+=over 4
+
+=item *
+
+Ken Williams, <ken@mathforum.org>
+
+=item *
+
+David Golden, <dagolden@cpan.org>
+
+=back
=head1 COPYRIGHT
-Copyright 2002-2003 Ken Williams. All rights reserved.
+Copyright 2002-2009 by Ken Williams, David Golden and other contributors. All
+rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
--- /dev/null
+
+# Testing the INCLUDE keyword
+
+int
+include_ok()
+CODE:
+ RETVAL = 1;
+OUTPUT:
+ RETVAL
+
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+=for testing
+
+This parts are ignored.
+
+=cut
+
+STATIC void
+outlist(int* a, int* b){
+ *a = 'a';
+ *b = 'b';
+}
+
+STATIC int
+len(const char* const s, int const l){
+ return l;
+}
+
+MODULE = XSMore PACKAGE = XSMore
+
+=for testing
+
+This parts are also ignored.
+
+=cut
+
+PROTOTYPES: ENABLE
+
+VERSIONCHECK: DISABLE
+
+REQUIRE: 2.20
+
+SCOPE: DISABLE
+
+FALLBACK: TRUE
+
+BOOT:
+ sv_setiv(get_sv("XSMore::boot_ok", TRUE), 100);
+
+
+void
+prototype_ssa()
+PROTOTYPE: $$@
+CODE:
+ NOOP;
+
+void
+attr_method(self, ...)
+ATTRS: method
+CODE:
+ NOOP;
+
+#define RET_1 1
+#define RET_2 2
+
+int
+return_1()
+CASE: ix == 1
+ ALIAS:
+ return_1 = RET_1
+ return_2 = RET_2
+ CODE:
+ RETVAL = ix;
+ OUTPUT:
+ RETVAL
+CASE: ix == 2
+ CODE:
+ RETVAL = ix;
+ OUTPUT:
+ RETVAL
+
+int
+arg_init(x)
+ int x = SvIV($arg);
+CODE:
+ RETVAL = x;
+OUTPUT:
+ RETVAL
+
+int
+myabs(...)
+OVERLOAD: abs
+CODE:
+ RETVAL = 42;
+OUTPUT:
+ RETVAL
+
+void
+hook(IN AV* av)
+INIT:
+ av_push(av, newSVpv("INIT", 0));
+CODE:
+ av_push(av, newSVpv("CODE", 0));
+POSTCALL:
+ av_push(av, newSVpv("POSTCALL", 0));
+CLEANUP:
+ av_push(av, newSVpv("CLEANUP", 0));
+
+
+void
+outlist(OUTLIST int a, OUTLIST int b)
+
+int
+len(char* s, int length(s))
+
+#if 1
+
+INCLUDE: XSInclude.xsh
+
+#else
+
+# for testing #else directive
+
+#endif
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use Test::More;
+use Config;
+use DynaLoader;
+use ExtUtils::CBuilder;
+use attributes;
+use overload;
+
+plan tests => 24;
+
+my ($source_file, $obj_file, $lib_file);
+
+require_ok( 'ExtUtils::ParseXS' );
+ExtUtils::ParseXS->import('process_file');
+
+chdir 't' or die "Can't chdir to t/, $!";
+
+use Carp; $SIG{__WARN__} = \&Carp::cluck;
+
+#########################
+
+$source_file = 'XSMore.c';
+
+# Try sending to file
+ExtUtils::ParseXS->process_file(
+ filename => 'XSMore.xs',
+ output => $source_file,
+);
+ok -e $source_file, "Create an output file";
+
+my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
+
+SKIP: {
+ skip "no compiler available", 2
+ if ! $b->have_compiler;
+ $obj_file = $b->compile( source => $source_file );
+ ok $obj_file;
+ ok -e $obj_file, "Make sure $obj_file exists";
+}
+
+SKIP: {
+ skip "no dynamic loading", 5
+ if !$b->have_compiler || !$Config{usedl};
+ my $module = 'XSMore';
+ $lib_file = $b->link( objects => $obj_file, module_name => $module );
+ ok $lib_file;
+ ok -e $lib_file, "Make sure $lib_file exists";
+
+ eval{
+ package XSMore;
+ our $VERSION = 42;
+ our $boot_ok;
+ DynaLoader::bootstrap_inherit(__PACKAGE__, $VERSION); # VERSIONCHECK disabled
+
+ sub new{ bless {}, shift }
+ };
+ is $@, '';
+ is ExtUtils::ParseXS::errors(), 0, 'ExtUtils::ParseXS::errors()';
+
+ is $XSMore::boot_ok, 100, 'the BOOT keyword';
+
+ ok XSMore::include_ok(), 'the INCLUDE keyword';
+ is prototype(\&XSMore::include_ok), "", 'the PROTOTYPES keyword';
+
+ is prototype(\&XSMore::prototype_ssa), '$$@', 'the PROTOTYPE keyword';
+
+ is_deeply [attributes::get(\&XSMore::attr_method)], [qw(method)], 'the ATTRS keyword';
+ is prototype(\&XSMore::attr_method), '$;@', 'ATTRS with prototype';
+
+ is XSMore::return_1(), 1, 'the CASE keyword (1)';
+ is XSMore::return_2(), 2, 'the CASE keyword (2)';
+ is prototype(\&XSMore::return_1), "", 'ALIAS with prototype (1)';
+ is prototype(\&XSMore::return_2), "", 'ALIAS with prototype (2)';
+
+ is XSMore::arg_init(200), 200, 'argument init';
+
+ ok overload::Overloaded(XSMore->new), 'the FALLBACK keyword';
+ is abs(XSMore->new), 42, 'the OVERLOAD keyword';
+
+ my @a;
+ XSMore::hook(\@a);
+ is_deeply \@a, [qw(INIT CODE POSTCALL CLEANUP)], 'the INIT & POSTCALL & CLEANUP keywords';
+
+ is_deeply [XSMore::outlist()], [ord('a'), ord('b')], 'the OUTLIST keyword';
+
+ is XSMore::len("foo"), 3, 'the length keyword';
+
+ # Win32 needs to close the DLL before it can unlink it, but unfortunately
+ # dl_unload_file was missing on Win32 prior to perl change #24679!
+ if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) {
+ for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) {
+ if ($DynaLoader::dl_modules[$i] eq $module) {
+ DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]);
+ last;
+ }
+ }
+ }
+}
+
+unless ($ENV{PERL_NO_CLEANUP}) {
+ for ( $obj_file, $lib_file, $source_file) {
+ next unless defined $_;
+ 1 while unlink $_;
+ }
+}
--- /dev/null
+# basic C types
+int T_IV
+unsigned T_UV
+unsigned int T_UV
+long T_IV
+unsigned long T_UV
+short T_IV
+unsigned short T_UV
+char T_CHAR
+unsigned char T_U_CHAR
+char * T_PV
+unsigned char * T_PV
+const char * T_PV
+caddr_t T_PV
+wchar_t * T_PV
+wchar_t T_IV
+# bool_t is defined in <rpc/rpc.h>
+bool_t T_IV
+size_t T_UV
+ssize_t T_IV
+time_t T_NV
+unsigned long * T_OPAQUEPTR
+char ** T_PACKEDARRAY
+void * T_PTR
+Time_t * T_PV
+SV * T_SV
+SVREF T_SVREF
+AV * T_AVREF
+HV * T_HVREF
+CV * T_CVREF
+
+IV T_IV
+UV T_UV
+NV T_NV
+I32 T_IV
+I16 T_IV
+I8 T_IV
+STRLEN T_UV
+U32 T_U_LONG
+U16 T_U_SHORT
+U8 T_UV
+Result T_U_CHAR
+Boolean T_BOOL
+float T_FLOAT
+double T_DOUBLE
+SysRet T_SYSRET
+SysRetLong T_SYSRET
+FILE * T_STDIO
+PerlIO * T_INOUT
+FileHandle T_PTROBJ
+InputStream T_IN
+InOutStream T_INOUT
+OutputStream T_OUT
+bool T_BOOL
+
+#############################################################################
+INPUT
+T_SV
+ $var = $arg
+T_SVREF
+ if (SvROK($arg))
+ $var = (SV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_AVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
+ $var = (AV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not an array reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_HVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
+ $var = (HV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a hash reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_CVREF
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
+ $var = (CV*)SvRV($arg);
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a code reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_SYSRET
+ $var NOT IMPLEMENTED
+T_UV
+ $var = ($type)SvUV($arg)
+T_IV
+ $var = ($type)SvIV($arg)
+T_INT
+ $var = (int)SvIV($arg)
+T_ENUM
+ $var = ($type)SvIV($arg)
+T_BOOL
+ $var = (bool)SvTRUE($arg)
+T_U_INT
+ $var = (unsigned int)SvUV($arg)
+T_SHORT
+ $var = (short)SvIV($arg)
+T_U_SHORT
+ $var = (unsigned short)SvUV($arg)
+T_LONG
+ $var = (long)SvIV($arg)
+T_U_LONG
+ $var = (unsigned long)SvUV($arg)
+T_CHAR
+ $var = (char)*SvPV_nolen($arg)
+T_U_CHAR
+ $var = (unsigned char)SvUV($arg)
+T_FLOAT
+ $var = (float)SvNV($arg)
+T_NV
+ $var = ($type)SvNV($arg)
+T_DOUBLE
+ $var = (double)SvNV($arg)
+T_PV
+ $var = ($type)SvPV_nolen($arg)
+T_PTR
+ $var = INT2PTR($type,SvIV($arg))
+T_PTRREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_REF_IV_REF
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type *, tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_REF_IV_PTR
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type, tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_PTROBJ
+ if (sv_derived_from($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_PTRDESC
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ ${type}_desc = (\U${type}_DESC\E*) tmp;
+ $var = ${type}_desc->ptr;
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_REFREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\")
+T_REFOBJ
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *INT2PTR($type,tmp);
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+T_OPAQUE
+ $var = *($type *)SvPV_nolen($arg)
+T_OPAQUEPTR
+ $var = ($type)SvPV_nolen($arg)
+T_PACKED
+ $var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+ $var = XS_unpack_$ntype($arg)
+T_CALLBACK
+ $var = make_perl_cb_$type($arg)
+T_ARRAY
+ U32 ix_$var = $argoff;
+ $var = $ntype(items -= $argoff);
+ while (items--) {
+ DO_ARRAY_ELEM;
+ ix_$var++;
+ }
+ /* this is the number of elements in the array */
+ ix_$var -= $argoff
+T_STDIO
+ $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
+T_IN
+ $var = IoIFP(sv_2io($arg))
+T_INOUT
+ $var = IoIFP(sv_2io($arg))
+T_OUT
+ $var = IoOFP(sv_2io($arg))
+#############################################################################
+OUTPUT
+T_SV
+ $arg = $var;
+T_SVREF
+ $arg = newRV((SV*)$var);
+T_AVREF
+ $arg = newRV((SV*)$var);
+T_HVREF
+ $arg = newRV((SV*)$var);
+T_CVREF
+ $arg = newRV((SV*)$var);
+T_IV
+ sv_setiv($arg, (IV)$var);
+T_UV
+ sv_setuv($arg, (UV)$var);
+T_INT
+ sv_setiv($arg, (IV)$var);
+T_SYSRET
+ if ($var != -1) {
+ if ($var == 0)
+ sv_setpvn($arg, "0 but true", 10);
+ else
+ sv_setiv($arg, (IV)$var);
+ }
+T_ENUM
+ sv_setiv($arg, (IV)$var);
+T_BOOL
+ $arg = boolSV($var);
+T_U_INT
+ sv_setuv($arg, (UV)$var);
+T_SHORT
+ sv_setiv($arg, (IV)$var);
+T_U_SHORT
+ sv_setuv($arg, (UV)$var);
+T_LONG
+ sv_setiv($arg, (IV)$var);
+T_U_LONG
+ sv_setuv($arg, (UV)$var);
+T_CHAR
+ sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+ sv_setuv($arg, (UV)$var);
+T_FLOAT
+ sv_setnv($arg, (double)$var);
+T_NV
+ sv_setnv($arg, (NV)$var);
+T_DOUBLE
+ sv_setnv($arg, (double)$var);
+T_PV
+ sv_setpv((SV*)$arg, $var);
+T_PTR
+ sv_setiv($arg, PTR2IV($var));
+T_PTRREF
+ sv_setref_pv($arg, Nullch, (void*)$var);
+T_REF_IV_REF
+ sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
+T_REF_IV_PTR
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTROBJ
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTRDESC
+ sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
+T_REFREF
+ NOT_IMPLEMENTED
+T_REFOBJ
+ NOT IMPLEMENTED
+T_OPAQUE
+ sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+ sv_setpvn($arg, (char *)$var, sizeof(*$var));
+T_PACKED
+ XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+ XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT
+ sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+ sv_setpvn($arg, $var.context.value().chp(),
+ $var.context.value().size());
+T_ARRAY
+ {
+ U32 ix_$var;
+ EXTEND(SP,size_$var);
+ for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
+ ST(ix_$var) = sv_newmortal();
+ DO_ARRAY_ELEM
+ }
+ }
+T_STDIO
+ {
+ GV *gv = newGVgen("$Package");
+ PerlIO *fp = PerlIO_importFILE($var,0);
+ if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_IN
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_INOUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_OUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
projects / p5sagit/p5-mst-13.2.git / commitdiff