From: Grant M. <gr...@us...> - 2002-10-17 08:44:36
|
Update of /cvsroot/perl-xml/xml-simple/t In directory usw-pr-cvs1:/tmp/cvs-serv18573/t Modified Files: 1_XMLin.t 9_Strict.t Log Message: - fixed stringification of keyattr values (reported by Trond Michelsen) Index: 1_XMLin.t =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- 1_XMLin.t 17 Oct 2002 07:29:44 -0000 1.6 +++ 1_XMLin.t 17 Oct 2002 08:44:33 -0000 1.7 @@ -15,7 +15,7 @@ plan skip_all => 'Test data missing'; } -plan tests => 64; +plan tests => 66; $@ = ''; @@ -315,6 +315,34 @@ }; $opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' }); is_deeply($opt, $target, "same again but with '+' prefix to copy keys"); + + +# Confirm the stringifying references bug is fixed + +my $xml = q( + <opt> + <item> + <name><firstname>Bob</firstname></name> + <age>21</age> + </item> + <item> + <name><firstname>Kate</firstname></name> + <age>22</age> + </item> + </opt>); + +$target = { + item => [ + { age => '21', name => { firstname => 'Bob'} }, + { age => '22', name => { firstname => 'Kate'} }, + ] +}; + +$opt = XMLin($xml); +is_deeply($opt, $target, "did not fold on default key with non-scalar value"); + +$opt = XMLin($xml, keyattr => { item => 'name' }); +is_deeply($opt, $target, "did not fold on specific key with non-scalar value"); # Make sure that the root element name is preserved if we ask for it Index: 9_Strict.t =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/t/9_Strict.t,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- 9_Strict.t 17 Oct 2002 07:29:44 -0000 1.1 +++ 9_Strict.t 17 Oct 2002 08:44:33 -0000 1.2 @@ -4,7 +4,7 @@ use strict; use Test::More; -plan tests => 13; +plan tests => 15; ############################################################################## @@ -87,6 +87,26 @@ isnt($@, '', 'key attribute missing from names element was a fatal error'); like($@, qr/<part> element has no 'partnum' key attribute/, + 'with the correct error message'); + + +# Confirm that stringification of references is trapped + +$xml = q( +<opt> + <item> + <name><firstname>Bob</firstname></name> + <age>21</age> + </item> +</opt> +); + +eval { + $opt = XMLin($xml, keyattr => { item => 'name' }, forcearray => ['item']); +}; + +isnt($@, '', 'key attribute not a scalar was a fatal error'); +like($@, qr/<item> element has non-scalar 'name' key attribute/, 'with the correct error message'); exit(0); |