Skip Menu |
 

This queue is for tickets about the YAML-Syck CPAN distribution.

Report information
The Basics
Id: 29115
Status: resolved
Priority: 0/
Queue: YAML-Syck

People
Owner: Nobody in particular
Requestors: rafl [...] debian.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.96
Fixed in: (no value)

Attachments


Subject: Loading !!perl/code with LoadCode = 0 inconsistent with YAML.pm
Download (untitled) / with headers
text/plain 212b
YAML.pm returns a coderef that does nothing (i.e. sub {}). YAML::Syck returns the actual code of the sub as a string. The attached patch makes things work like in YAML.pm and adds tests for this behaviour. -Flo
Subject: YAML-Syck-FLORA-NoLoadCode.diff
diff --git a/perl_syck.h b/perl_syck.h index 4a8e292..cb4afc7 100644 --- a/perl_syck.h +++ b/perl_syck.h @@ -203,46 +203,52 @@ yaml_syck_parser_handler sv = newSVpv(blob, len); #ifndef YAML_IS_JSON #ifdef PERL_LOADMOD_NOIMPORT - } else if (load_code && (strEQ(id, "perl/code") || strnEQ(id, "perl/code:", 10))) { - SV *cv; - SV *text, *sub; - char *pkg = id + 10; + } else if (strEQ(id, "perl/code") || strnEQ(id, "perl/code:", 10)) { + SV *cv; + SV *sub; + char *pkg = id + 10; - /* This code is copypasted from Storable.xs */ + if (load_code) { + SV *text; - /* - * prepend "sub " to the source - */ + /* This code is copypasted from Storable.xs */ - text = newSVpvn(n->data.str->ptr, n->data.str->len); + /* + * prepend "sub " to the source + */ - sub = newSVpvn("sub ", 4); - sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */ - SvREFCNT_dec(text); + text = newSVpvn(n->data.str->ptr, n->data.str->len); - ENTER; - SAVETMPS; + sub = newSVpvn("sub ", 4); + sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */ + SvREFCNT_dec(text); + } else { + sub = newSVpvn("sub {}", 6); + } - cv = eval_pv(SvPV_nolen(sub), TRUE); + ENTER; + SAVETMPS; - sv_2mortal(sub); + cv = eval_pv(SvPV_nolen(sub), TRUE); - if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) { - sv = cv; - } else { - croak("code %s did not evaluate to a subroutine reference\n", SvPV_nolen(sub)); - } + sv_2mortal(sub); - if ( (*(pkg - 1) != '\0') && (*pkg != '\0') ) { - sv_bless(sv, gv_stashpv(pkg, TRUE)); - } + if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) { + sv = cv; + } else { + croak("code %s did not evaluate to a subroutine reference\n", SvPV_nolen(sub)); + } + + SvREFCNT_inc(sv); /* XXX seems to be necessary */ - SvREFCNT_inc(sv); /* XXX seems to be necessary */ + FREETMPS; + LEAVE; - FREETMPS; - LEAVE; + if ( (*(pkg - 1) != '\0') && (*pkg != '\0') ) { + sv_bless(sv, gv_stashpv(pkg, TRUE)); + } - /* END Storable */ + /* END Storable */ } else if (strnEQ( n->data.str->ptr, REF_LITERAL, 1+REF_LITERAL_LENGTH)) { /* type tag in a scalar ref */ diff --git a/t/2-scalars.t b/t/2-scalars.t index 77e2c0a..bc7cf13 100644 --- a/t/2-scalars.t +++ b/t/2-scalars.t @@ -1,4 +1,4 @@ -use t::TestYAML tests => 71; +use t::TestYAML tests => 75; local $SIG{__WARN__} = sub { 1 } if $Test::VERSION < 1.20; @@ -20,6 +20,19 @@ is(Dump(sub{ 42 }), "--- !!perl/code: '{ \"DUMMY\" }'\n"); $YAML::Syck::DumpCode = 1; ok(Dump(sub{ 42 }) =~ m#--- !!perl/code.*?{.*?42.*?}$#s); +$YAML::Syck::LoadCode = 0; +{ + my $not_sub = Load("--- !!perl/code:Some::Class '{ \"foo\" . shift }'\n"); + is( ref $not_sub, "Some::Class" ); + is( $not_sub->("bar"), undef ); +} + +{ + my $sub = Load("--- !!perl/code '{ \"foo\" . shift }'\n"); + is( ref $sub, "CODE" ); + is( $sub->("bar"), undef ); +} + my $like_yaml_pm = 0; $YAML::Syck::LoadCode = 0; ok( my $not_sub = Load("--- !!perl/Class '{ \"foo\" . shift }'\n") );
Subject: Re: [rt.cpan.org #29115] Loading !!perl/code with LoadCode = 0 inconsistent with YAML.pm
Date: Mon, 3 Sep 2007 00:22:31 +0800
To: bug-YAML-Syck [...] rt.cpan.org
From: Audrey Tang <audreyt [...] audreyt.org>
Download (untitled) / with headers
text/plain 438b
在 Sep 2, 2007 11:34 PM 時,Florian Ragwitz via RT 寫到: Show quoted text
> Transaction: Ticket created by FLORA > Queue: YAML-Syck > Subject: Loading !!perl/code with LoadCode = 0 inconsistent > with YAML.pm > Broken in: 0.96 > Severity: Normal > Owner: Nobody > Requestors: rafl@debian.org > Status: new > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=29115 >
Thanks, applied anf released! Audrey


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.