Skip Menu |
 

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

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

People
Owner: TODDR [...] cpan.org
Requestors: daydream.trippers [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: 1.10_02



Subject: Loaded self-refererring document is corrupted
Date: Wed, 13 Dec 2006 15:56:18 +0900
To: bug-YAML-Syck [...] rt.cpan.org
From: "Nobuaki ITO" <daydream.trippers [...] gmail.com>
Download (untitled) / with headers
text/plain 625b
Dear maintainers. First, load YAML to $doc, --- abc: &1 {} def: *1 Change second component with: $doc->{def} = 'xyz'; Now, expected result is: $doc = { abc => {}, def => 'xyz' } But, I got: $doc = { abc => 'xyz', def => 'xyz' } $doc->{abc} and $doc->{def} seem to point to same storage. In following test script, test #3 fails. === use t::TestYAML tests => 3; my $a = { abc => {} }; $a->{'def'} = $a->{'abc'}; is(Dump($a), "--- \nabc: &1 {}\n\ndef: *1\n"); my $b = Load(Dump($a)); $a->{'def'} = 'xyz'; is(Dump($a), "--- \nabc: {}\n\ndef: xyz\n"); $b->{'def'} = 'xyz'; is(Dump($b), "--- \nabc: {}\n\ndef: xyz\n");
From: Nobuaki ITO <banb [...] yahoo.co.jp>
Download (untitled) / with headers
text/plain 662b
Dear maintainers. I've found the causal mechanism on that bug. In short, same reference pointers (RV) were re-used for aliased nodes. ex. --- label1: &1 [ 'foo', 'bar' ] label2: *1 In this situation, current parser generates the tree in which 'label1' node and 'label2' node have the same RV. label1 => RV[id:0, refcount:2] => AV[refcount: 1]( 'foo', 'bar' ) label2 => RV[id:0, refcount:2] => AV[refcount: 1]( 'foo', 'bar' ) This is not correct. Ideally: label1 => RV[id:0, refcount:1] => AV[refcount: 2]( 'foo', 'bar' ) label2 => RV[id:1, refcount:1] => AV[refcount: 2]( 'foo', 'bar' ) a bit huge patches and test script (for 0.82) are attached.
Download yaml-alias.t
text/x-perl 1.7k
#!/usr/bin/perl use t::TestYAML tests => 14; my ($a, $b); *skip = *Test::skip; $a = [ {} ]; $a->[1] = $a->[0]; $b = Load(Dump($a)); is(Dump($b), Dump($a), "array with anchor"); $a->[1] = 'xyz'; $b->[1] = 'xyz'; is(Dump($b), Dump($a), "touched array with anchor"); $a = { abc => {} }; $a->{'def'} = $a->{'abc'}; $b = Load(Dump($a)); is(Dump($b), Dump($a), "hash with anchor"); $a->{'def'} = 'xyz'; $b->{'def'} = 'xyz'; is(Dump($b), Dump($a), "touched hash with anchor"); $a = [ {} ]; push @$a, $a->[0] for (1..10); $b = Load(Dump($a)); is(Dump($b), Dump($a), "huge array with anchor"); $a->[0] = 'xyz'; $b->[0] = 'xyz'; is(Dump($b), Dump($a), "touched huge array with anchor"); $a = { abc => {}, def => {} }; $a->{abc}->{sibling} = $a->{def}; $a->{def}->{sibling} = $a->{abc}; $b = Load(Dump($a)); is(Dump($b), Dump($a), "circular"); $a->{def}->{sibling} = {}; $b->{def}->{sibling} = {}; is(Dump($b), Dump($a), "touched circular"); $a = [ {}, {} ]; push @$a, $a->[0], $a->[1] for (1..10); $b = Load(Dump($a)); is(Dump($b), Dump($a), "many anchors"); $a->[0] = 'abc'; $a->[3] = 'def'; $b->[0] = 'abc'; $b->[3] = 'def'; is(Dump($b), Dump($a), "touched many anchors"); my $s = 'scal'; $a = [ \$s, \$s, \$s ]; $b = Load(Dump($a)); is(Dump($b), Dump($a), "scalar reference"); $a->[1] = 'hello'; $b->[1] = 'hello'; is(Dump($b), Dump($a), "touched scalar reference"); my $os = bless \$s, 'obj_scal'; my $oa = bless [ 'array' ], 'obj_array'; my $oh = bless { key => 'value' }, 'obj_hash'; $a = [ $os, $oa, $oh, $os, $oa, $oh ]; $b = Load(Dump($a)); skip("Skip this because anchor #1 is going to be truncated. no problem", Dump($b), Dump($a), "object"); $a->[3] = 'mod'; $a->[4] = {}; $a->[5] = $a->[4]; $b->[3] = 'mod'; $b->[4] = {}; $b->[5] = $b->[4]; is(Dump($b), Dump($a), "touched object");
Subject: Repost the patches
From: Nobuaki ITO <banb [...] yahoo.co.jp>
I failed to upload the patches so I'm goint to repost.
Download perl_common_h.patch
text/x-diff 570b
--- perl_common.h.orig 2007-01-26 07:52:19.000000000 +0900 +++ perl_common.h 2007-02-02 13:25:08.909512131 +0900 @@ -39,6 +39,7 @@ AV *objects; bool implicit_unicode; bool load_code; + HV *bad_anchors; }; SV* perl_syck_lookup_sym( SyckParser *p, SYMID v) { @@ -62,7 +63,7 @@ (SYMID)newSVpvn_share("name", 4, 0), (SYMID)newSVpvn_share(a, strlen(a), 0) ); - badanc->type_id = syck_strndup( "!perl:YAML::Syck::BadAlias", 25 ); + badanc->type_id = syck_strndup( "!perl:YAML::Syck::BadAlias", 26 ); return badanc; }
Download perl_syck_h.patch
text/x-diff 4.9k
--- perl_syck.h.orig 2007-01-26 08:15:04.000000000 +0900 +++ perl_syck.h 2007-02-02 16:24:05.408316219 +0900 @@ -63,6 +63,80 @@ #define TRACK_OBJECT(sv) (av_push(((struct parser_xtra *)p->bonus)->objects, sv)) #define USE_OBJECT(sv) (SvREFCNT_inc(sv)) +#ifndef YAML_IS_JSON + +#ifndef SvRV_set /* prior to 5.8.7; thx charsbar! */ +#define SvRV_set(sv, val) \ + STMT_START { \ + (SvRV(sv) = (val)); } STMT_END +#endif + +static const char * +is_bad_alias_object( SV *sv ) { + SV *hv, **psv; + + if (! sv_isobject(sv)) + return NULL; + + hv = SvRV(sv); + if (! strnEQ(sv_reftype(hv, 1), "YAML::Syck::BadAlias", 20-1)) + return NULL; + + psv = hv_fetch((HV *) hv, "name", 4, 0); + if (! psv) + return NULL; + + return SvPVX(*psv); +} + +static void +register_bad_alias( SyckParser *p, const char *anchor, SV *sv ) { + HV *map; + SV **pref_av, *new_rvav; + AV *rvs; + + map = ((struct parser_xtra *)p->bonus)->bad_anchors; + pref_av = hv_fetch(map, anchor, strlen(anchor), 0); + if (! pref_av) { + new_rvav = newRV_noinc((SV *) newAV()); + hv_store(map, anchor, strlen(anchor), new_rvav, 0); + pref_av = &new_rvav; + } + rvs = (AV *) SvRV(*pref_av); + + SvREFCNT_inc(sv); + av_push(rvs, sv); +} + +static void +resolve_bad_alias( SyckParser *p, const char *anchor, SV *sv ) { + HV *map; + SV **pref_av, *entity; + AV *rvs; + I32 len, i; + + entity = SvRV(sv); + + map = ((struct parser_xtra *)p->bonus)->bad_anchors; + pref_av = hv_fetch(map, anchor, strlen(anchor), 0); + if (! pref_av) + return; + + rvs = (AV *) SvRV(*pref_av); + len = av_len(rvs)+1; + for (i = 0; i < len; i ++) { + SV **prv = av_fetch(rvs, i, 0); + if (prv) { + SvREFCNT_dec(SvRV(*prv)); + SvRV_set(*prv, entity); + SvREFCNT_inc(entity); + } + } + av_clear(rvs); +} + +#endif + SYMID #ifdef YAML_IS_JSON json_syck_parser_handler @@ -270,6 +344,14 @@ seq = newAV(); for (i = 0; i < n->data.list->idx; i++) { SV *a = perl_syck_lookup_sym(p, syck_seq_read(n, i)); +#ifndef YAML_IS_JSON + const char *forward_anchor; + + a = sv_2mortal(newSVsv(a)); + forward_anchor = is_bad_alias_object(a); + if (forward_anchor) + register_bad_alias(p, forward_anchor, a); +#endif av_push(seq, a); USE_OBJECT(a); } @@ -312,7 +394,14 @@ SV* key = perl_syck_lookup_sym(p, syck_map_read(n, map_key, 0)); SV* val = perl_syck_lookup_sym(p, syck_map_read(n, map_value, 0)); char *ref_type = SvPVX(key); +#if 0 /* need not to duplicate scalar reference */ + const char *forward_anchor; + val = sv_2mortal(newSVsv(val)); + forward_anchor = is_bad_alias_object(val); + if (forward_anchor) + register_bad_alias(p, forward_anchor, val); +#endif sv = newRV_noinc(val); USE_OBJECT(val); @@ -341,6 +430,15 @@ } } } + else if (id && strnEQ(id, "perl:YAML::Syck::BadAlias", 25-1)) { + SV* key = (SV *) syck_map_read(n, map_key, 0); + SV* val = (SV *) syck_map_read(n, map_value, 0); + map = newHV(); + if (hv_store_ent(map, key, val, 0) != NULL) + USE_OBJECT(val); + sv = newRV_noinc((SV*)map); + sv_bless(sv, gv_stashpv("YAML::Syck::BadAlias", TRUE)); + } else #endif { @@ -349,7 +447,14 @@ for (i = 0; i < n->data.pairs->idx; i++) { SV* key = perl_syck_lookup_sym(p, syck_map_read(n, map_key, i)); SV* val = perl_syck_lookup_sym(p, syck_map_read(n, map_value, i)); +#ifndef YAML_IS_JSON + const char *forward_anchor; + val = sv_2mortal(newSVsv(val)); + forward_anchor = is_bad_alias_object(val); + if (forward_anchor) + register_bad_alias(p, forward_anchor, val); +#endif if (hv_store_ent(map, key, val, 0) != NULL) USE_OBJECT(val); } @@ -387,6 +492,9 @@ #ifndef YAML_IS_JSON /* Fix bad anchors using sv_setsv */ if (n->id) { + if (n->anchor) + resolve_bad_alias(p, n->anchor, sv); + sv_setsv( perl_syck_lookup_sym(p, n->id), sv ); } #endif @@ -521,6 +629,9 @@ bonus.objects = (AV*)sv_2mortal((SV*)newAV()); bonus.implicit_unicode = SvTRUE(implicit_unicode); bonus.load_code = SvTRUE(use_code) || SvTRUE(load_code); +#ifndef YAML_IS_JSON + bonus.bad_anchors = (HV*)sv_2mortal((SV*)newHV()); +#endif parser->bonus = &bonus; #ifndef YAML_IS_JSON
Download (untitled) / with headers
text/plain 1.2k
On Tue Feb 06 20:23:09 2007, banb@yahoo.co.jp wrote: Show quoted text
> Dear maintainers.
... Show quoted text
> a bit huge patches and test script (for 0.82) are attached.
Thanks, please update them to the Git version if this issue still exists. (This is a form-reply that isn't specific to your particular report) YAML::Syck has just acquired one new maintainer (me), it still doesn't have anyone that *cares* about it. But I'm willing to help solve your report & release a new version with the fix if it's easy for me. It now has a Git repository at: http://github.com/avar/YAML-Syck If your report is a patch that fixes a problem, great. Please remake the patch against Git by forking that repo and sending me a pull request on GitHub (or an update to this bug if you prefer git-format-patch(1) or some other repo provider..). Make sure to include a test for what you fixed. If your report is some code that fails (and you have a testcase for it) a patch against the test suite to demonstrate that failure would be very useful. It's OK if the test crashes and burns, see Test::More's docs for how to make TODO tests that fail now, but shouldn't. Even if it segfaults perl C<system $^X => qw/ -Mblib -MYAML::Syck .../> or something like that and checking the return value will do.
Has patch. needs review.
Patch added to 1.10_03


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.