X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=indirect.xs;h=a9012cdf062582057bbc6e80a72fc83cfc4b6116;hb=9e7e0702d84f54976fa798516817f55e342fe0be;hp=67cba846a98299092b75e3e919150c2c711ca843;hpb=3244106ca331b0d58c903b449f3c26af8f2d2d1e;p=perl%2Fmodules%2Findirect.git diff --git a/indirect.xs b/indirect.xs index 67cba84..a9012cd 100644 --- a/indirect.xs +++ b/indirect.xs @@ -1,19 +1,26 @@ +/* This file is part of the indirect Perl module. + * See http://search.cpan.org/dist/indirect/ */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#ifndef SvPV_const +# define SvPV_const SvPV +#endif + +#ifndef SvPV_nolen_const +# define SvPV_nolen_const SvPV_nolen +#endif + #ifndef SvPVX_const # define SvPVX_const SvPVX #endif -STATIC U32 indirect_initialized = 0; -STATIC U32 indirect_hash = 0; - -STATIC const char indirect_msg[] = "Indirect call of method \"%s\" on object \"%s\""; +/* ... Hints ............................................................... */ -STATIC HV *indirect_map = NULL; -STATIC const char *indirect_linestr = NULL; +STATIC U32 indirect_hash = 0; STATIC UV indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) @@ -22,9 +29,14 @@ STATIC UV indirect_hint(pTHX) { "indirect", 8, 0, indirect_hash); - return SvOK(id) ? SvUV(id) : 0; + return SvIOK(id) ? SvUV(id) : 0; } +/* ... op -> source position ............................................... */ + +STATIC HV *indirect_map = NULL; +STATIC const char *indirect_linestr = NULL; + STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { #define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N)) char buf[32]; @@ -46,16 +58,18 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { val = newSVsv(sv); SvUPGRADE(val, SVt_PVIV); SvUVX(val) = PTR2UV(src); + SvIOK_on(val); + SvIsUV_on(val); if (!hv_store(indirect_map, buf, sprintf(buf, "%u", PTR2UV(o)), val, 0)) SvREFCNT_dec(val); } -STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV **name) { +STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { #define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S)) char buf[32]; SV **val; - if (indirect_linestr != SvPVX(PL_parser->linestr)) + if (indirect_linestr != SvPVX_const(PL_parser->linestr)) return NULL; val = hv_fetch(indirect_map, buf, sprintf(buf, "%u", PTR2UV(o)), 0); @@ -87,6 +101,8 @@ STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) { return p; } +/* ... ck_const ............................................................ */ + STATIC OP *(*indirect_old_ck_const)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_const(pTHX_ OP *o) { @@ -99,6 +115,8 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_const)(aTHX_ o); } +/* ... ck_rv2sv ............................................................ */ + STATIC OP *(*indirect_old_ck_rv2sv)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { @@ -115,6 +133,8 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); } +/* ... ck_padany ........................................................... */ + STATIC OP *(*indirect_old_ck_padany)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_padany(pTHX_ OP *o) { @@ -132,6 +152,8 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_padany)(aTHX_ o); } +/* ... ck_method ........................................................... */ + STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_method(pTHX_ OP *o) { @@ -156,6 +178,10 @@ done: return CALL_FPTR(indirect_old_ck_method)(aTHX_ o); } +/* ... ck_entersub ......................................................... */ + +STATIC const char indirect_msg[] = "Indirect call of method \"%s\" on object \"%s\""; + STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { @@ -179,14 +205,23 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { goto done; pm = indirect_map_fetch(om, &svm); po = indirect_map_fetch(oo, &svo); - if (pm && po && pm < po) - ((hint == 2) ? croak : warn)(indirect_msg, SvPV_nolen(svm), SvPV_nolen(svo)); + if (pm && po && pm < po) { + const char *psvm = SvPV_nolen_const(svm), *psvo = SvPV_nolen_const(svo); + if (hint == 2) + croak(indirect_msg, psvm, psvo); + else + warn(indirect_msg, psvm, psvo); + } } done: return CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o); } +STATIC U32 indirect_initialized = 0; + +/* --- XS ------------------------------------------------------------------ */ + MODULE = indirect PACKAGE = indirect PROTOTYPES: DISABLE