[perl-xml-cvs] CVS: xml-simple/t 1_XMLin.t, 1.27, 1.28 9_Strict.t, 1.5, 1.6

[Grant M. <gr...@us...>]

Update of /cvsroot/perl-xml/xml-simple/t
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23871/t

Modified Files:
	1_XMLin.t 9_Strict.t 
Log Message:
- add die_or_warn handling for non-unique key attributes values during array folding

Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- 1_XMLin.t	2 Aug 2007 10:35:40 -0000	1.27
+++ 1_XMLin.t	15 Aug 2007 10:36:48 -0000	1.28
@@ -17,7 +17,7 @@
   plan skip_all => 'Test data missing';
 }
 
-plan tests => 122;
+plan tests => 131;
 
 
 my $last_warning = '';
@@ -363,15 +363,15 @@
   ]
 };
 
-$last_warning = '';
-$opt = XMLin($xml, @cont_key);
-is_deeply($opt, $target, "did not fold on default key with non-scalar value");
-is($last_warning, '', 'no warning issued');
-
 {
   local($SIG{__WARN__}) = \&warn_handler;
 
   $last_warning = '';
+  $opt = XMLin($xml, @cont_key);
+  is_deeply($opt, $target, "did not fold on default key with non-scalar value");
+  is($last_warning, '', 'no warning issued');
+
+  $last_warning = '';
   $opt = XMLin($xml, keyattr => { item => 'name' }, @cont_key);
   is_deeply($opt, $target, "did not fold on specific key with non-scalar value");
   isnt($last_warning, '', 'warning issued as expected');
@@ -381,6 +381,15 @@
   );
 
   $last_warning = '';
+  $opt = XMLin($xml, keyattr => [ 'name' ], @cont_key);
+  is_deeply($opt, $target, "same again but with keyattr as array");
+  isnt($last_warning, '', 'warning issued as expected');
+  like($last_warning, 
+    qr{<item> element has non-scalar 'name' key attribute},
+    'text in warning is correct'
+  );
+
+  $last_warning = '';
   local($^W) = 0;
   $opt = XMLin($xml, keyattr => { item => 'name' }, @cont_key);
   is_deeply($opt, $target, "did not fold on specific key with non-scalar value");
@@ -410,6 +419,38 @@
   $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
   is_deeply($opt, $items, "same again");
   is($last_warning, '', 'but with no warning this time');
+
+  $last_warning = '';
+  $^W = 1;
+  $xitems = q(<opt>
+    <item name="color">red</item>
+    <item name="mass">heavy</item>
+    <item name="disposition">ornery</item>
+    <item name="color">green</item>
+  </opt>);
+  $items = {
+    'item' => {
+      'color'       => 'green',
+      'mass'        => 'heavy',
+      'disposition' => 'ornery',
+    }
+  };
+  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
+  is_deeply($opt, $items, "folded elements despite non-unique key attribute");
+  like($last_warning, qr{Warning: <item> element has non-unique value in 'name' key attribute: color},
+    'expected warning issued');
+
+  $last_warning = '';
+  $opt = XMLin($xitems, keyattr => [ 'name' ], @cont_key);
+  is_deeply($opt, $items, "same again but with keyattr as array");
+  like($last_warning, qr{Warning: <item> element has non-unique value in 'name' key attribute: color},
+    'expected warning issued');
+
+  $last_warning = '';
+  $^W = 0;
+  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
+  is_deeply($opt, $items, "same again");
+  is($last_warning, '', 'but with no warning this time');
 }
 
 

Index: 9_Strict.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/9_Strict.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- 9_Strict.t	18 May 2003 08:43:14 -0000	1.5
+++ 9_Strict.t	15 Aug 2007 10:36:48 -0000	1.6
@@ -6,7 +6,7 @@
 
 $^W = 1;
 
-plan tests => 38;
+plan tests => 40;
 
 
 ##############################################################################
@@ -92,6 +92,25 @@
   'with the correct error message');
 
 
+# Confirm that non-unique values in key attributes are detected
+
+$xml = q(
+<opt>
+  <part partnum="12345" desc="Thingy" />
+  <part partnum="67890" desc="Wotsit" />
+  <part partnum="12345" desc="Springy" />
+</opt>
+);
+
+eval {
+  $opt = XMLin($xml, keyattr => { part => 'partnum' }, forcearray => 1);
+};
+
+isnt($@, '', 'non-unique key attribute values was a fatal error');
+like($@, qr/(?i)<part> element has non-unique value in 'partnum' key attribute: 12345/,
+  'with the correct error message');
+
+
 # Confirm that stringification of references is trapped
 
 $xml = q(