diff options
| author | David Leadbeater <dgl@dgl.cx> | 2010-12-03 09:01:55 +0000 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2010-12-04 11:42:17 -0800 |
| commit | 70b88f4168267af61728134c18f30d84f4fc10b6 (patch) | |
| tree | 84642e433b5ba0cf9e9614433f36416840e997a0 /dist | |
| parent | 5b6010b3c3f40e7db51b877d5227c4c80caaa5bb (diff) | |
| download | perl-70b88f4168267af61728134c18f30d84f4fc10b6.tar.gz | |
Make Storable correctly store coderefs with UTF-8 flag
Diffstat (limited to 'dist')
| -rw-r--r-- | dist/Storable/Storable.xs | 37 | ||||
| -rw-r--r-- | dist/Storable/t/code.t | 12 |
2 files changed, 36 insertions, 13 deletions
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 1654557d67..6a1ddb3fe6 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -2698,7 +2698,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv) * Now store the source code. */ - STORE_SCALAR(SvPV_nolen(text), len); + if(SvUTF8 (text)) + STORE_UTF8STR(SvPV_nolen(text), len); + else + STORE_SCALAR(SvPV_nolen(text), len); FREETMPS; LEAVE; @@ -5350,7 +5353,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) dSP; int type, count, tagnum; SV *cv; - SV *sv, *text, *sub; + SV *sv, *text, *sub, *errsv; TRACEME(("retrieve_code (#%d)", cxt->tagnum)); @@ -5378,6 +5381,12 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) case SX_LSCALAR: text = retrieve_lscalar(aTHX_ cxt, cname); break; + case SX_UTF8STR: + text = retrieve_utf8str(aTHX_ cxt, cname); + break; + case SX_LUTF8STR: + text = retrieve_lutf8str(aTHX_ cxt, cname); + break; default: CROAK(("Unexpected type %d in retrieve_code\n", type)); } @@ -5387,6 +5396,8 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) */ sub = newSVpvn("sub ", 4); + if (SvUTF8(text)) + SvUTF8_on(sub); sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */ SvREFCNT_dec(text); @@ -5416,25 +5427,27 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) ENTER; SAVETMPS; + errsv = get_sv("@", GV_ADD); + sv_setpvn(errsv, "", 0); /* clear $@ */ if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) { - SV* errsv = get_sv("@", GV_ADD); - sv_setpvn(errsv, "", 0); /* clear $@ */ PUSHMARK(sp); XPUSHs(sv_2mortal(newSVsv(sub))); PUTBACK; count = call_sv(cxt->eval, G_SCALAR); - SPAGAIN; if (count != 1) CROAK(("Unexpected return value from $Storable::Eval callback\n")); - cv = POPs; - if (SvTRUE(errsv)) { - CROAK(("code %s caused an error: %s", - SvPV_nolen(sub), SvPV_nolen(errsv))); - } - PUTBACK; } else { - cv = eval_pv(SvPV_nolen(sub), TRUE); + eval_sv(sub, G_SCALAR); } + SPAGAIN; + cv = POPs; + PUTBACK; + + if (SvTRUE(errsv)) { + CROAK(("code %s caused an error: %s", + SvPV_nolen(sub), SvPV_nolen(errsv))); + } + if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) { sv = SvRV(cv); } else { diff --git a/dist/Storable/t/code.t b/dist/Storable/t/code.t index a51dffc7aa..33b52b9e28 100644 --- a/dist/Storable/t/code.t +++ b/dist/Storable/t/code.t @@ -33,7 +33,7 @@ BEGIN { } } -BEGIN { plan tests => 59 } +BEGIN { plan tests => 63 } use Storable qw(retrieve store nstore freeze nfreeze thaw dclone); use Safe; @@ -305,3 +305,13 @@ is(prototype($thawed->[4]), prototype($obj[0]->[4])); } } + +{ + my @text = ("hello", "\x{a3}", "\x{a3} \x{2234}", "\x{2234}\x{2234}"); + + for my $text(@text) { + my $res = (thaw freeze eval "sub {'" . $text . "'}")->(); + ok($res eq $text); + } +} + |