summaryrefslogtreecommitdiff
path: root/dist/ExtUtils-ParseXS/t/107-make_targetable.t
diff options
context:
space:
mode:
Diffstat (limited to 'dist/ExtUtils-ParseXS/t/107-make_targetable.t')
-rw-r--r--dist/ExtUtils-ParseXS/t/107-make_targetable.t146
1 files changed, 146 insertions, 0 deletions
diff --git a/dist/ExtUtils-ParseXS/t/107-make_targetable.t b/dist/ExtUtils-ParseXS/t/107-make_targetable.t
new file mode 100644
index 0000000000..fde608f4e0
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/107-make_targetable.t
@@ -0,0 +1,146 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw( tempdir );
+use Test::More qw(no_plan); # tests => 7;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+ make_targetable
+);
+
+my $output_expr_ref = {
+ 'T_CALLBACK' => ' sv_setpvn($arg, $var.context.value().chp(),
+ $var.context.value().size());
+',
+ '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;
+ }
+',
+ 'T_REF_IV_PTR' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)$var);
+',
+ 'T_U_LONG' => ' sv_setuv($arg, (UV)$var);
+',
+ 'T_U_CHAR' => ' sv_setuv($arg, (UV)$var);
+',
+ 'T_U_INT' => ' sv_setuv($arg, (UV)$var);
+',
+ '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_NV' => ' sv_setnv($arg, (NV)$var);
+',
+ 'T_SHORT' => ' sv_setiv($arg, (IV)$var);
+',
+ 'T_OPAQUE' => ' sv_setpvn($arg, (char *)&$var, sizeof($var));
+',
+ 'T_PTROBJ' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)$var);
+',
+ 'T_HVREF' => ' $arg = newRV((SV*)$var);
+',
+ 'T_PACKEDARRAY' => ' XS_pack_$ntype($arg, $var, count_$ntype);
+',
+ 'T_INT' => ' sv_setiv($arg, (IV)$var);
+',
+ 'T_OPAQUEPTR' => ' sv_setpvn($arg, (char *)$var, sizeof(*$var));
+',
+ 'T_BOOL' => ' $arg = boolSV($var);
+',
+ 'T_REFREF' => ' NOT_IMPLEMENTED
+',
+ 'T_REF_IV_REF' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)new $ntype($var));
+',
+ '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_FLOAT' => ' sv_setnv($arg, (double)$var);
+',
+ '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_PV' => ' sv_setpv((SV*)$arg, $var);
+',
+ '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_CHAR' => ' sv_setpvn($arg, (char *)&$var, 1);
+',
+ 'T_LONG' => ' sv_setiv($arg, (IV)$var);
+',
+ 'T_DOUBLE' => ' sv_setnv($arg, (double)$var);
+',
+ 'T_PTR' => ' sv_setiv($arg, PTR2IV($var));
+',
+ 'T_AVREF' => ' $arg = newRV((SV*)$var);
+',
+ 'T_SV' => ' $arg = $var;
+',
+ 'T_ENUM' => ' sv_setiv($arg, (IV)$var);
+',
+ 'T_REFOBJ' => ' NOT IMPLEMENTED
+',
+ 'T_CVREF' => ' $arg = newRV((SV*)$var);
+',
+ 'T_UV' => ' sv_setuv($arg, (UV)$var);
+',
+ 'T_PACKED' => ' XS_pack_$ntype($arg, $var);
+',
+ 'T_SYSRET' => ' if ($var != -1) {
+ if ($var == 0)
+ sv_setpvn($arg, "0 but true", 10);
+ else
+ sv_setiv($arg, (IV)$var);
+ }
+',
+ 'T_IV' => ' sv_setiv($arg, (IV)$var);
+',
+ 'T_PTRDESC' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)new\\U${type}_DESC\\E($var));
+',
+ 'T_DATAUNIT' => ' sv_setpvn($arg, $var.chp(), $var.size());
+',
+ 'T_U_SHORT' => ' sv_setuv($arg, (UV)$var);
+',
+ 'T_SVREF' => ' $arg = newRV((SV*)$var);
+',
+ 'T_PTRREF' => ' sv_setref_pv($arg, Nullch, (void*)$var);
+',
+};
+
+my %targetable;
+%targetable = make_targetable($output_expr_ref);
+
+ok(! exists $targetable{'T_AVREF'},
+ "Element found in 'output_expr' not found in \%targetable: not an 'sv_set'" );
+
+ok(exists $targetable{'T_CALLBACK'},
+ "Element found in 'output_expr' found in \%targetable as expected" );
+
+pass("Passed all tests in $0");