… | |
… | |
42 | MODULE = Devel::FindRef PACKAGE = Devel::FindRef |
42 | MODULE = Devel::FindRef PACKAGE = Devel::FindRef |
43 | |
43 | |
44 | PROTOTYPES: ENABLE |
44 | PROTOTYPES: ENABLE |
45 | |
45 | |
46 | void |
46 | void |
47 | find_ (SV *target) |
47 | find_ (SV *target_ref) |
48 | PPCODE: |
48 | PPCODE: |
49 | { |
49 | { |
50 | SV *arena, *targ; |
50 | SV *arena, *targ; |
51 | U32 rmagical; |
51 | U32 rmagical; |
52 | int i; |
52 | int i; |
53 | AV *about = newAV (); |
53 | AV *about = newAV (); |
54 | AV *excl = newAV (); |
54 | AV *excl = newAV (); |
55 | |
55 | |
56 | if (!SvROK (target)) |
56 | if (!SvROK (target_ref)) |
57 | croak ("find expects a reference to a perl value"); |
57 | croak ("find expects a reference to a perl value"); |
58 | |
58 | |
59 | targ = SvRV (target); |
59 | targ = SvRV (target_ref); |
60 | |
60 | |
61 | for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena)) |
61 | for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena)) |
62 | { |
62 | { |
63 | UV idx = SvREFCNT (arena); |
63 | UV idx = SvREFCNT (arena); |
64 | |
64 | |
… | |
… | |
98 | mg = mg->mg_moremagic; |
98 | mg = mg->mg_moremagic; |
99 | } |
99 | } |
100 | } |
100 | } |
101 | } |
101 | } |
102 | |
102 | |
103 | if (SvROK (sv) && !SvWEAKREF (sv)) |
103 | if (SvROK (sv)) |
104 | { |
104 | { |
105 | if (sv != target && SvRV (sv) == targ && !SvWEAKREF (sv)) |
105 | if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref) |
106 | res_pair ("referenced by"); |
106 | res_pair ("referenced by"); |
107 | } |
107 | } |
108 | else |
108 | else |
109 | switch (SvTYPE (sv)) |
109 | switch (SvTYPE (sv)) |
110 | { |
110 | { |
… | |
… | |
201 | if (rmagical) |
201 | if (rmagical) |
202 | SvRMAGICAL_on (sv); |
202 | SvRMAGICAL_on (sv); |
203 | } |
203 | } |
204 | } |
204 | } |
205 | |
205 | |
|
|
206 | /* look at the mortalise stack of the current coroutine */ |
|
|
207 | for (i = 0; i <= PL_tmps_ix; ++i) |
|
|
208 | if (PL_tmps_stack [i] == targ) |
|
|
209 | res_text ("a temporary on the stack"); |
|
|
210 | |
206 | if (targ == (SV*)PL_main_cv) |
211 | if (targ == (SV*)PL_main_cv) |
207 | res_text ("the main body of the program"); |
212 | res_text ("the main body of the program"); |
208 | |
213 | |
209 | EXTEND (SP, 2); |
214 | EXTEND (SP, 2); |
210 | PUSHs (sv_2mortal (newRV_noinc ((SV *)about))); |
215 | PUSHs (sv_2mortal (newRV_noinc ((SV *)about))); |