| … | |
… | |
| 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))); |
