summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-07-07 02:51:45 -0500
committerJesse Luehrs <doy@tozt.net>2011-07-07 02:51:45 -0500
commit0dab6d38d596535a09af16a4feba57358ca67849 (patch)
tree4bf86b089fbff872e305a26acd1fe7d609301746
parent64e93875cecc7af2d630399eb30fdc2e2cbd27e6 (diff)
downloadsmartmatch-0dab6d38d596535a09af16a4feba57358ca67849.tar.gz
smartmatch-0dab6d38d596535a09af16a4feba57358ca67849.zip
make this actually lexical
-rw-r--r--dist.ini1
-rw-r--r--hook_op_check_smartmatch.h3
-rw-r--r--lib/smartmatch.pm10
-rw-r--r--smartmatch.xs47
-rw-r--r--t/core.t4
5 files changed, 31 insertions, 34 deletions
diff --git a/dist.ini b/dist.ini
index 1c2f7ca..60c256c 100644
--- a/dist.ini
+++ b/dist.ini
@@ -13,7 +13,6 @@ dist = smartmatch
[=inc::MakeMaker]
[Prereqs]
-B::Hooks::EndOfScope = 0
B::Hooks::OP::Check = 0.14
[Prereqs / ConfigureRequires]
diff --git a/hook_op_check_smartmatch.h b/hook_op_check_smartmatch.h
index 781a05e..b6ddf19 100644
--- a/hook_op_check_smartmatch.h
+++ b/hook_op_check_smartmatch.h
@@ -4,7 +4,6 @@
#include "perl.h"
#include "hook_op_check.h"
-UV hook_op_check_smartmatch(void *user_data);
-void *hook_op_check_smartmatch_remove(UV id);
+UV hook_op_check_smartmatch();
#endif
diff --git a/lib/smartmatch.pm b/lib/smartmatch.pm
index fd15e03..505b7c8 100644
--- a/lib/smartmatch.pm
+++ b/lib/smartmatch.pm
@@ -5,7 +5,6 @@ use warnings;
use parent 'DynaLoader';
use B::Hooks::OP::Check;
-use B::Hooks::EndOfScope;
sub dl_load_flags { 0x01 }
@@ -29,16 +28,11 @@ sub import {
$cb = $engine->can('match') unless ref($cb);
}
- $^H ||= 0x020000; # HINT_LOCALIZE_HH
-
- $package->unimport;
- $^H{'smartmatch_cb'} = smartmatch::register($cb);
- on_scope_end { $package->unimport };
+ smartmatch::register($cb);
}
sub unimport {
- return unless exists $^H{'smartmatch_cb'};
- smartmatch::unregister(delete $^H{'smartmatch_cb'});
+ smartmatch::unregister();
}
1;
diff --git a/smartmatch.xs b/smartmatch.xs
index 23a4f17..36d7c51 100644
--- a/smartmatch.xs
+++ b/smartmatch.xs
@@ -10,6 +10,12 @@ STATIC OP*
smartmatch_cb(pTHX_ OP *o, void *user_data)
{
OP *left, *right, *cb_op, *list, *new;
+ SV **cb;
+
+ cb = hv_fetchs(GvHV(PL_hintgv), "smartmatch_cb", 0);
+ if (!cb) {
+ return o;
+ }
left = cBINOPo->op_first;
right = left->op_sibling;
@@ -17,7 +23,7 @@ smartmatch_cb(pTHX_ OP *o, void *user_data)
o->op_flags &= ~OPf_KIDS;
op_free(o);
- cb_op = newCVREF(0, newSVOP(OP_CONST, 0, newSVsv(user_data)));
+ cb_op = newCVREF(0, newSVOP(OP_CONST, 0, newSVsv(*cb)));
list = newLISTOP(OP_LIST, 0, left, right);
new = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, list, cb_op));
@@ -26,22 +32,19 @@ smartmatch_cb(pTHX_ OP *o, void *user_data)
}
UV
-hook_op_check_smartmatch(void *user_data)
-{
- return hook_op_check(OP_SMARTMATCH, smartmatch_cb, user_data);
-}
-
-void *
-hook_op_check_smartmatch_remove(UV id)
+hook_op_check_smartmatch()
{
- return hook_op_check_remove(OP_SMARTMATCH, id);
+ return hook_op_check(OP_SMARTMATCH, smartmatch_cb, NULL);
}
MODULE = smartmatch PACKAGE = smartmatch
PROTOTYPES: DISABLE
-UV
+BOOT:
+ hook_op_check_smartmatch();
+
+void
register (cb)
SV *cb;
CODE:
@@ -49,17 +52,19 @@ register (cb)
croak("not a coderef");
}
- RETVAL = hook_op_check_smartmatch(newSVsv(cb));
- OUTPUT:
- RETVAL
+ PL_hints |= HINT_LOCALIZE_HH;
+ gv_HVadd(PL_hintgv);
-void
-unregister (id)
- UV id;
- PREINIT:
- SV *cb;
- CODE:
- cb = hook_op_check_smartmatch_remove(id);
- if (cb) {
+ SvREFCNT_inc(cb);
+ if (!hv_stores(GvHV(PL_hintgv), "smartmatch_cb", cb)) {
SvREFCNT_dec(cb);
+ croak("couldn't store the callback");
}
+
+void
+unregister ()
+ CODE:
+ PL_hints |= HINT_LOCALIZE_HH;
+ gv_HVadd(PL_hintgv);
+
+ hv_delete(GvHV(PL_hintgv), "smartmatch_cb", 13, G_DISCARD);
diff --git a/t/core.t b/t/core.t
index 81b2ac7..69c0942 100644
--- a/t/core.t
+++ b/t/core.t
@@ -86,10 +86,10 @@ while (<DATA>) {
test_again:
my $res;
if ($note =~ /NOWARNINGS/) {
- $res = eval "use smartmatch 'core'; no warnings; $tstr";
+ $res = eval "no warnings; $tstr";
}
else {
- $res = eval "use smartmatch 'core'; $tstr";
+ $res = eval $tstr;
}
chomp $@;