-
Notifications
You must be signed in to change notification settings - Fork 4
/
WithOverloading.xs
63 lines (53 loc) · 1.71 KB
/
WithOverloading.xs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
static void
S_reset_amagic (pTHX_ SV *rv, const bool on)
{
/* It is assumed that you've already turned magic on/off on rv */
SV *sva;
SV *const target = SvRV (rv);
/* Less 1 for the reference we've already dealt with. */
U32 how_many = SvREFCNT (target) - 1;
MAGIC *mg;
if (SvMAGICAL (target) && (mg = mg_find (target, PERL_MAGIC_backref))) {
/* Back referneces also need to be found, but aren't part of the target's reference count. */
how_many += 1 + av_len ((AV *)mg->mg_obj);
}
if (!how_many) {
/* There was only 1 reference to this object. */
return;
}
for (sva = PL_sv_arenaroot; sva; sva = (SV *)SvANY (sva)) {
register const SV *const svend = &sva[SvREFCNT (sva)];
register SV *sv;
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE (sv) != SVTYPEMASK
&& ((sv->sv_flags & SVf_ROK) == SVf_ROK)
&& SvREFCNT (sv)
&& SvRV (sv) == target
&& sv != rv) {
if (on) {
SvAMAGIC_on (sv);
}
else {
SvAMAGIC_off (sv);
}
if (--how_many == 0) {
/* We have found them all. */
return;
}
}
}
}
}
MODULE = MooseX::Role::WithOverloading PACKAGE = MooseX::Role::WithOverloading::Meta::Role::Application::FixOverloadedRefs
PROTOTYPES: DISABLE
void
reset_amagic (rv)
SV *rv
CODE:
if (Gv_AMG (SvSTASH (SvRV (rv))) && !SvAMAGIC (rv)) {
SvAMAGIC_on (rv);
S_reset_amagic (aTHX_ rv, TRUE);
}