diff options
Diffstat (limited to 'dist/ExtUtils-ParseXS/t/107-make_targetable.t')
-rw-r--r-- | dist/ExtUtils-ParseXS/t/107-make_targetable.t | 146 |
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"); |