From: Vincent Pit Date: Fri, 5 Dec 2008 18:15:37 +0000 (+0100) Subject: Support for perl 5.8 X-Git-Tag: v0.09~6 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=73065691a24f100af6f7fd8055ccca40772f42b2 Support for perl 5.8 --- diff --git a/Makefile.PL b/Makefile.PL index 57df486..0ab9c24 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,4 @@ -use 5.009004; +use 5.008; use strict; use warnings; diff --git a/indirect.xs b/indirect.xs index f8312ac..ad4a23f 100644 --- a/indirect.xs +++ b/indirect.xs @@ -22,17 +22,63 @@ # define sv_catpvn_nomg sv_catpvn #endif +#ifndef HvNAME_get +# define HvNAME_get(H) HvNAME(H) +#endif + +#ifndef HvNAMELEN_get +# define HvNAMELEN_get(H) strlen(HvNAME_get(H)) +#endif + +#define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) + +#if I_HAS_PERL(5, 10, 0) || defined(PL_parser) +# ifndef PL_lex_inwhat +# define PL_lex_inwhat PL_parser->lex_inwhat +# endif +# ifndef PL_linestr +# define PL_linestr PL_parser->linestr +# endif +# ifndef PL_bufptr +# define PL_bufptr PL_parser->bufptr +# endif +# ifndef PL_oldbufptr +# define PL_oldbufptr PL_parser->oldbufptr +# endif +#else +# ifndef PL_lex_inwhat +# define PL_lex_inwhat PL_Ilex_inwhat +# endif +# ifndef PL_linestr +# define PL_linestr PL_Ilinestr +# endif +# ifndef PL_bufptr +# define PL_bufptr PL_Ibufptr +# endif +# ifndef PL_oldbufptr +# define PL_oldbufptr PL_Ioldbufptr +# endif +#endif + /* ... Hints ............................................................... */ STATIC U32 indirect_hash = 0; STATIC IV indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) - SV *id = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, - NULL, - "indirect", 8, - 0, - indirect_hash); + SV *id; +#if I_HAS_PERL(5, 10, 0) + id = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, + NULL, + "indirect", 8, + 0, + indirect_hash); +#else + SV **val = hv_fetch(GvHV(PL_hintgv), "indirect", 8, indirect_hash); + if (!val) + return 0; + id = *val; +#endif return (id && SvOK(id) && SvIOK(id)) ? SvIV(id) : 0; } @@ -53,8 +99,8 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { * In this case the linestr has temporarly changed, but the old buffer should * still be alive somewhere. */ - if (!PL_parser->lex_inwhat) { - pl_linestr = SvPVX_const(PL_parser->linestr); + if (!PL_lex_inwhat) { + pl_linestr = SvPVX_const(PL_linestr); if (indirect_linestr != pl_linestr) { hv_clear(indirect_map); indirect_linestr = pl_linestr; @@ -74,7 +120,7 @@ STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { char buf[32]; SV **val; - if (indirect_linestr != SvPVX_const(PL_parser->linestr)) + if (indirect_linestr != SvPVX_const(PL_linestr)) return NULL; val = hv_fetch(indirect_map, buf, OP2STR(o), 0); @@ -141,7 +187,7 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { if (indirect_hint()) { SV *sv = cSVOPo_sv; if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) - indirect_map_store(o, indirect_find(sv, PL_parser->oldbufptr), sv); + indirect_map_store(o, indirect_find(sv, PL_oldbufptr), sv); } return o; @@ -178,7 +224,7 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { sv = sv_2mortal(newSVpvn("$", 1)); sv_catpvn_nomg(sv, name, len); - s = indirect_find(sv, PL_parser->oldbufptr); + s = indirect_find(sv, PL_oldbufptr); if (!s) { /* If it failed, retry without the current stash */ const char *stash = HvNAME_get(PL_curstash); STRLEN stashlen = HvNAMELEN_get(PL_curstash); @@ -196,7 +242,7 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { sv_setpvn(sv, "$", 1); stashlen += 2; sv_catpvn_nomg(sv, name + stashlen, len - stashlen); - s = indirect_find(sv, PL_parser->oldbufptr); + s = indirect_find(sv, PL_oldbufptr); if (!s) goto done; } @@ -219,7 +265,7 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { if (indirect_hint()) { SV *sv; - const char *s = PL_parser->oldbufptr, *t = PL_parser->bufptr - 1; + const char *s = PL_oldbufptr, *t = PL_bufptr - 1; while (s < t && isSPACE(*s)) ++s; if (*s == '$' && ++s <= t) { @@ -248,7 +294,7 @@ STATIC OP *indirect_ck_method(pTHX_ OP *o) { if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV)) goto done; sv = sv_mortalcopy(sv); - s = indirect_find(sv, PL_parser->oldbufptr); + s = indirect_find(sv, PL_oldbufptr); } o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o); /* o may now be a method_named */ diff --git a/lib/indirect.pm b/lib/indirect.pm index ebfb264..138172e 100644 --- a/lib/indirect.pm +++ b/lib/indirect.pm @@ -1,5 +1,7 @@ package indirect; +use 5.008; + use strict; use warnings; @@ -60,12 +62,13 @@ sub import { sub unimport { (undef, my $type) = @_; + $^H |= 0x00020000; $^H{indirect} = (defined $type and $type eq ':fatal') ? 2 : 1; } =head1 DEPENDENCIES -L 5.9.4. +L 5.8. L (standard since perl 5.006). diff --git a/t/10-good.t b/t/10-good.t index 32b62ec..d428d1f 100644 --- a/t/10-good.t +++ b/t/10-good.t @@ -147,9 +147,9 @@ meh $x, 1, 2; meh $y; #### meh $y, 1, 2; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z meh $z; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z meh $z, 1, 2; #### print; @@ -163,9 +163,9 @@ print $x "oh hai\n"; print $y; #### print $y "dongs\n"; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z print $z; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z print $z "hlagh\n"; #### print STDOUT "bananananananana\n"; diff --git a/t/20-bad.t b/t/20-bad.t index 5abb4ad..c480d6c 100644 --- a/t/20-bad.t +++ b/t/20-bad.t @@ -148,11 +148,11 @@ meh $y; meh $y 1, 2; #### meh $y, 1, 2; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z meh $z; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z meh $z 1, 2; -#### # use feature 'state'; state $z +#### $] < 5.010 # use feature 'state'; state $z meh $z, 1, 2; #### package sploosh;