Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
BHK.pm	260 B	-r--r--r--	2014-12-27 11:48
Block.pm	9 B	-r--r--r--	2014-12-27 11:48
Markers.pm	245 B	-r--r--r--	2014-12-27 11:48
Null.pm	3 B	-r--r--r--	2014-12-27 11:48
addissub.t	481 B	-r--r--r--	2014-12-27 11:48
arrayexpr.t	7.85 KB	-r--r--r--	2014-12-27 11:48
autoload.t	4.03 KB	-r--r--r--	2014-12-27 11:48
blockasexpr.t	1.46 KB	-r--r--r--	2014-12-27 11:48
blockhooks-csc.t	2.26 KB	-r--r--r--	2014-12-27 11:48
blockhooks.t	5.21 KB	-r--r--r--	2014-12-27 11:48
call.t	8.9 KB	-r--r--r--	2014-12-27 11:49
call_checker.t	4.03 KB	-r--r--r--	2014-12-27 11:49
caller.t	1.78 KB	-r--r--r--	2014-12-27 11:48
callregexec.t	2.46 KB	-r--r--r--	2014-12-27 11:49
check_warnings.t	495 B	-r--r--r--	2014-12-27 11:48
cleanup.t	1.41 KB	-r--r--r--	2014-12-27 11:48
clone-with-stack.t	1.45 KB	-r--r--r--	2015-01-10 12:06
cophh.t	280 B	-r--r--r--	2014-12-27 11:48
coplabel.t	112 B	-r--r--r--	2014-12-27 11:48
copstash.t	156 B	-r--r--r--	2014-12-27 11:48
copyhints.t	123 B	-r--r--r--	2014-12-27 11:48
customop.t	2.42 KB	-r--r--r--	2014-12-27 11:49
eval-filter.t	743 B	-r--r--r--	2014-12-27 11:48
exception.t	616 B	-r--r--r--	2014-12-27 11:48
fetch_pad_names.t	10.58 KB	-r--r--r--	2014-12-27 11:49
gotosub.t	351 B	-r--r--r--	2014-12-27 11:48
grok.t	2.07 KB	-r--r--r--	2014-12-27 11:49
gv_autoload4.t	2.01 KB	-r--r--r--	2014-12-27 11:48
gv_fetchmeth.t	2.3 KB	-r--r--r--	2014-12-27 11:48
gv_fetchmeth_autoload.t	3.38 KB	-r--r--r--	2014-12-27 11:48
gv_fetchmethod_flags.t	1.86 KB	-r--r--r--	2014-12-27 11:48
gv_init.t	489 B	-r--r--r--	2014-12-27 11:48
handy.t	15.33 KB	-r--r--r--	2014-12-27 11:49
hash.t	17.07 KB	-r--r--r--	2014-12-27 11:48
keyword_multiline.t	259 B	-r--r--r--	2014-12-27 11:48
keyword_plugin.t	1.15 KB	-r--r--r--	2014-12-27 11:48
labelconst.aux	146 B	-r--r--r--	2014-12-27 11:48
labelconst.t	2.63 KB	-r--r--r--	2014-12-27 11:48
labelconst_utf8.aux	194 B	-r--r--r--	2014-12-27 11:48
lexsub.t	524 B	-r--r--r--	2014-12-27 11:48
loopblock.t	1.46 KB	-r--r--r--	2014-12-27 11:48
looprest.t	1.39 KB	-r--r--r--	2014-12-27 11:48
lvalue.t	800 B	-r--r--r--	2014-12-27 11:48
magic.t	804 B	-r--r--r--	2014-12-27 11:49
magic_chain.t	115 B	-r--r--r--	2014-12-27 11:48
mro.t	237 B	-r--r--r--	2014-12-27 11:48
multicall.t	1.32 KB	-r--r--r--	2014-12-27 11:48
my_cxt.t	1.28 KB	-r--r--r--	2014-12-27 11:48
my_exit.t	790 B	-r--r--r--	2014-12-27 11:48
newCONSTSUB.t	2.58 KB	-r--r--r--	2014-12-27 11:48
op.t	359 B	-r--r--r--	2014-12-27 11:48
op_contextualize.t	120 B	-r--r--r--	2014-12-27 11:48
op_list.t	151 B	-r--r--r--	2014-12-27 11:48
overload.t	2.21 KB	-r--r--r--	2014-12-27 11:48
pad_scalar.t	1.83 KB	-r--r--r--	2014-12-27 11:48
peep.t	1013 B	-r--r--r--	2014-12-27 11:48
pmflag.t	192 B	-r--r--r--	2014-12-27 11:48
postinc.t	800 B	-r--r--r--	2014-12-27 11:48
printf.t	1.05 KB	-r--r--r--	2014-12-27 11:49
ptr_table.t	916 B	-r--r--r--	2014-12-27 11:48
push.t	746 B	-r--r--r--	2014-12-27 11:48
refs.t	578 B	-r--r--r--	2014-12-27 11:48
rmagical.t	823 B	-r--r--r--	2014-12-27 11:48
rv2cv_op_cv.t	115 B	-r--r--r--	2014-12-27 11:48
savehints.t	123 B	-r--r--r--	2014-12-27 11:48
scopelessblock.t	1.59 KB	-r--r--r--	2014-12-27 11:48
sort.t	411 B	-r--r--r--	2014-12-27 11:48
stmtasexpr.t	893 B	-r--r--r--	2014-12-27 11:48
stmtsasexpr.t	949 B	-r--r--r--	2014-12-27 11:48
stuff_modify_bug.t	151 B	-r--r--r--	2014-12-27 11:48
stuff_svcur_bug.t	260 B	-r--r--r--	2014-12-27 11:48
subcall.t	179 B	-r--r--r--	2014-12-27 11:48
sviscow.t	229 B	-r--r--r--	2014-12-27 11:48
svpeek.t	3.16 KB	-r--r--r--	2014-12-27 11:49
svpv.t	1.01 KB	-r--r--r--	2014-12-27 11:48
svpv_magic.t	1.29 KB	-r--r--r--	2014-12-27 11:48
svsetsv.t	1015 B	-r--r--r--	2014-12-27 11:48
swaplabel.t	7.06 KB	-r--r--r--	2014-12-27 11:48
swaptwostmts.t	2.79 KB	-r--r--r--	2014-12-27 11:48
sym-hook.t	730 B	-r--r--r--	2014-12-27 11:48
temp_lv_sub.t	532 B	-r--r--r--	2014-12-27 11:48
underscore_length.t	338 B	-r--r--r--	2014-12-27 11:48
utf16_to_utf8.t	2.09 KB	-r--r--r--	2014-12-27 11:48
utf8.t	13.46 KB	-r--r--r--	2014-12-27 11:48
whichsig.t	653 B	-r--r--r--	2014-12-27 11:48
xs_special_subs.t	6.54 KB	-r--r--r--	2014-12-27 11:48
xs_special_subs_require.t	7.46 KB	-r--r--r--	2014-12-27 11:48
xsub_h.t	2.81 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl

use warnings;
use strict;

use Test::More tests => 24;
use XS::APItest;

my $ppaddr = xop_ppaddr;

my $av = xop_build_optree;

is $av->[2], "NAME:custom",     "unregistered XOPs have default name";
is $av->[3], "DESC:unknown custom operator",
                                "unregistered XOPs have default desc";
is $av->[4], "CLASS:0",         "unregistered XOPs are BASEOPs";
is scalar @$av, 5,              "unregistered XOPs don't call peep";

my $names = xop_custom_op_names;
$names->{$ppaddr} = "foo";
$av = xop_build_optree;

is $av->[2], "NAME:foo",        "PL_custom_op_names honoured";
is $av->[3], "DESC:unknown custom operator",
                                "PL_custom_op_descs can be empty";
is $av->[4], "CLASS:0",         "class fallback still works";

# this will segfault if the HV isn't there
my $ops = xop_custom_ops;
pass                            "PL_custom_ops created OK";

my $descs = xop_custom_op_descs;
$descs->{$ppaddr} = "bar";
# this is not generally a supported operation
delete $ops->{$ppaddr};
$av = xop_build_optree;

is $av->[3], "DESC:bar",        "PL_custom_op_descs honoured";

my $xop = xop_my_xop;
delete $ops->{$ppaddr};
delete $names->{$ppaddr};
delete $descs->{$ppaddr};
xop_register;

is $ops->{$ppaddr}, $xop,       "XOP registered OK";

is xop_from_custom_op, $xop,    "XOP lookup from OP roundtrips";

$av = xop_build_optree;
my $OA_UNOP = xop_OA_UNOP;
my ($unop, $kid) = ("???" x 2);

# we can't use 'like', since that runs the match in a different scope
# and so doesn't set $1
ok $av->[0] =~ /unop:([0-9a-f]+)/,  "got unop address"
    and $unop = $1;
ok $av->[1] =~ /kid:([0-9a-f]+)/,   "got kid address"
    and $kid = $1;

is $av->[2], "NAME:my_xop",     "OP_NAME returns registered name";
is $av->[3], "DESC:XOP for testing", "OP_DESC returns registered desc";
is $av->[4], "CLASS:$OA_UNOP",  "OP_CLASS returns registered class";
is scalar @$av, 7,              "registered peep called";
is $av->[5], "peep:$unop",      "...with correct 'o' param";
is $av->[6], "oldop:$kid",      "...and correct 'oldop' param";

xop_clear;

is $ops->{$ppaddr}, $xop,       "clearing XOP doesn't remove it";

$av = xop_build_optree;

is $av->[2], "NAME:custom",     "clearing XOP resets name";
is $av->[3], "DESC:unknown custom operator",
                                "clearing XOP resets desc";
is $av->[4], "CLASS:0",         "clearing XOP resets class";
is scalar @$av, 5,              "clearing XOP removes peep";