Menu
▾
▴
[perl-xml-cvs] CVS: xml-simple/t 0_Config.t,1.2,1.3 1_XMLin.t,1.4,1.5 2_XMLout.t,1.3,1.4 3_Storable.t,1.4,1.5 4_MemShare.t,1.2,1.3 5_MemCopy.t,1.3,1.4 6_ObjIntf.t,1.3,1.4 7_SaxStuff.t,1.1,1.2 8_Namespaces.t,1.3,1.4
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv21017/t
Modified Files:
0_Config.t 1_XMLin.t 2_XMLout.t 3_Storable.t 4_MemShare.t
5_MemCopy.t 6_ObjIntf.t 7_SaxStuff.t 8_Namespaces.t
Log Message:
- ported tests scripts to Test::More for improved diagnostics
Index: 0_Config.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/0_Config.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 0_Config.t 5 Feb 2002 22:28:31 -0000 1.2
+++ 0_Config.t 16 Oct 2002 09:43:35 -0000 1.3
@@ -1,9 +1,8 @@
# $Id$
-
-BEGIN { print "1..1\n"; }
+# vim: syntax=perl
use strict;
-use File::Spec;
+use Test::More tests => 1;
# Build up a list of installed modules
@@ -52,14 +51,14 @@
# Print details of installed modules on STDERR
-printf STDERR "\r%-30s %s\n", 'Package', 'Version';
+diag(sprintf("\r%-30s %s\n", 'Package', 'Version'));
foreach my $module (@mod_list) {
$version{$module} = 'Not Installed' unless(defined($version{$module}));
$version{$module} .= " (default parser)" if($module eq $default_parser);
$version{$module} .= " (preferred parser)" if($module eq $preferred_parser);
- printf STDERR " %-30s %s\n", $module, $version{$module};
+ diag(sprintf(" %-30s %s\n", $module, $version{$module}));
}
# Housekeeping
-print "ok 1\n";
+ok(1, "Dumped config");
Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- 1_XMLin.t 14 Feb 2002 21:37:05 -0000 1.4
+++ 1_XMLin.t 16 Oct 2002 09:43:35 -0000 1.5
@@ -1,116 +1,28 @@
# $Id$
+# vim: syntax=perl
use strict;
+use Test::More;
use IO::File;
use File::Spec;
+
# Initialise filenames and check they're there
my $XMLFile = File::Spec->catfile('t', 'test1.xml'); # t/test1.xml
unless(-e $XMLFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
-}
-
-
-print "1..63\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
-
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
-}
-
-
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!defined($x)) {
- return(1) if(!defined($y));
- print STDERR "$t:DataCompare: undef != $y\n";
- return(0);
- }
-
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
-
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s), (", join(', ', keys(%$x)),
- ") got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
+ plan skip_all => 'Test data missing';
}
+plan tests => 64;
-##############################################################################
-# T E S T R O U T I N E S
-##############################################################################
+$@ = '';
eval "use XML::Simple;";
-ok(1, !$@); # Module compiled OK
+is($@, '', 'Module compiled OK');
unless($XML::Simple::VERSION eq '1.08_01') {
- print STDERR "Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 1.08_01)...";
+ diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 1.08_01)");
}
@@ -123,10 +35,10 @@
name2 => 'value2',
};
-ok(2, 1); # XMLin() didn't crash
-ok(3, defined($opt)); # and it returned a value
-ok(4, ref($opt) eq 'HASH'); # and a hasref at that
-ok(5, DataCompare($opt, $expected));
+ok(1, "XMLin() didn't crash");
+ok(defined($opt), 'and it returned a value');
+is(ref($opt), 'HASH', 'and a hasref at that');
+is_deeply($opt, $expected, 'matches expectations (attributes)');
# Now try a slightly more complex one that returns the same value
@@ -137,7 +49,7 @@
<name2>value2</name2>
</opt>
));
-ok(6, DataCompare($opt, $expected));
+is_deeply($opt, $expected, 'same again with nested elements');
# And something else that returns the same (line break included to pick up
@@ -145,7 +57,7 @@
$opt = XMLin(q(<opt name1="value1"
name2="value2" />));
-ok(7, DataCompare($opt, $expected));
+is_deeply($opt, $expected, 'attributes in empty element');
# Try something with two lists of nested values
@@ -161,10 +73,10 @@
</opt>)
);
-ok(8, DataCompare($opt, {
+is_deeply($opt, {
name1 => [ 'value1.1', 'value1.2', 'value1.3' ],
name2 => [ 'value2.1', 'value2.2', 'value2.3' ],
-}));
+}, 'repeated child elements give arrays of scalars');
# Now a simple nested hash
@@ -175,9 +87,9 @@
</opt>)
);
-ok(9, DataCompare($opt, {
+is_deeply($opt, {
item => { name1 => 'value1', name2 => 'value2' }
-}));
+}, 'nested element gives hash');
# Now a list of nested hashes
@@ -188,12 +100,12 @@
<item name1="value3" name2="value4" />
</opt>)
);
-ok(10, DataCompare($opt, {
+is_deeply($opt, {
item => [
{ name1 => 'value1', name2 => 'value2' },
{ name1 => 'value3', name2 => 'value4' }
]
-}));
+}, 'repeated child elements give list of hashes');
# Now a list of nested hashes transformed into a hash using default key names
@@ -211,7 +123,7 @@
}
};
$opt = XMLin($string);
-ok(11, DataCompare($opt, $target));
+is_deeply($opt, $target, "array folded on default key 'name'");
# Same thing left as an array by suppressing default key names
@@ -223,13 +135,13 @@
]
};
$opt = XMLin($string, keyattr => [] );
-ok(12, DataCompare($opt, $target));
+is_deeply($opt, $target, 'not folded when keyattr turned off');
# Same again with alternative key suppression
$opt = XMLin($string, keyattr => {} );
-ok(13, DataCompare($opt, $target));
+is_deeply($opt, $target, 'still works when keyattr is empty hash');
# Try the other two default key attribute names
@@ -240,12 +152,12 @@
<item key="item2" attr1="value3" attr2="value4" />
</opt>
));
-ok(14, DataCompare($opt, {
+is_deeply($opt, {
item => {
item1 => { attr1 => 'value1', attr2 => 'value2' },
item2 => { attr1 => 'value3', attr2 => 'value4' }
}
-}));
+}, "folded on default key 'key'");
$opt = XMLin(q(
@@ -254,12 +166,12 @@
<item id="item2" attr1="value3" attr2="value4" />
</opt>
));
-ok(15, DataCompare($opt, {
+is_deeply($opt, {
item => {
item1 => { attr1 => 'value1', attr2 => 'value2' },
item2 => { attr1 => 'value3', attr2 => 'value4' }
}
-}));
+}, "folded on default key 'id'");
# Similar thing using non-standard key names
@@ -278,25 +190,25 @@
};
$opt = XMLin($xml, keyattr => [qw(xname)]);
-ok(16, DataCompare($opt, $target));
+is_deeply($opt, $target, "folded on non-default key 'xname'");
# And with precise element/key specification
$opt = XMLin($xml, keyattr => { 'item' => 'xname' });
-ok(17, DataCompare($opt, $target));
+is_deeply($opt, $target, 'same again but keyattr set with hash');
# Same again but with key field further down the list
$opt = XMLin($xml, keyattr => [qw(wibble xname)]);
-ok(18, DataCompare($opt, $target));
+is_deeply($opt, $target, 'keyattr as array with value in second position');
# Same again but with key field supplied as scalar
$opt = XMLin($xml, keyattr => qw(xname));
-ok(19, DataCompare($opt, $target));
+is_deeply($opt, $target, 'keyattr as scalar');
# Weird variation, not exactly what we wanted but it is what we expected
@@ -318,7 +230,7 @@
};
$opt = XMLin($xml);
-ok(20, DataCompare($opt, $target));
+is_deeply($opt, $target, 'fold same array on two different keys');
# Or somewhat more as one might expect
@@ -330,7 +242,7 @@
}
};
$opt = XMLin($xml, keyattr => { 'item' => 'id' });
-ok(21, DataCompare($opt, $target));
+is_deeply($opt, $target, 'same again but with priority switch');
# Now a somewhat more complex test of targetting folding
@@ -370,7 +282,7 @@
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => 'license', 'option' => 'pn' });
-ok(22, DataCompare($opt, $target));
+is_deeply($opt, $target, 'folded on multi-key keyattr hash');
# Now try leaving the keys in place
@@ -402,7 +314,7 @@
}
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' });
-ok(23, DataCompare($opt, $target));
+is_deeply($opt, $target, "same again but with '+' prefix to copy keys");
# Make sure that the root element name is preserved if we ask for it
@@ -413,85 +325,96 @@
$opt = XMLin( $xml, forcearray => 1, keeproot => 1,
keyattr => { 'car' => '+license', 'option' => '-pn' });
-ok(24, DataCompare($opt, $target));
+is_deeply($opt, $target, 'keeproot option works');
# confirm that CDATA sections parse correctly
$xml = q{<opt><cdata><![CDATA[<greeting>Hello, world!</greeting>]]></cdata></opt>};
$opt = XMLin($xml);
-ok(25, DataCompare($opt, {
+is_deeply($opt, {
'cdata' => '<greeting>Hello, world!</greeting>'
-}));
+}, 'CDATA section parsed correctly');
$xml = q{<opt><x><![CDATA[<y>one</y>]]><![CDATA[<y>two</y>]]></x></opt>};
$opt = XMLin($xml);
-ok(26, DataCompare($opt, {
+is_deeply($opt, {
'x' => '<y>one</y><y>two</y>'
-}));
+}, 'CDATA section containing markup characters parsed correctly');
# Try parsing a named external file
+$@ = '';
$opt = eval{ XMLin($XMLFile); };
-ok(27, !$@); # XMLin didn't die
-print STDERR $@ if($@);
-ok(28, DataCompare($opt, {
+is($@, '', "XMLin didn't choke on named external file");
+is_deeply($opt, {
location => 't/test1.xml'
-}));
+}, 'and contents parsed as expected');
# Try parsing default external file (scriptname.xml in script directory)
+$@ = '';
$opt = eval { XMLin(); };
-print STDERR $@ if($@);
-ok(29, !$@); # XMLin didn't die
-ok(30, DataCompare($opt, {
+is($@, '', "XMLin didn't choke on un-named (default) external file");
+is_deeply($opt, {
location => 't/1_XMLin.xml'
-}));
+}, 'and contents parsed as expected');
# Try parsing named file in a directory in the searchpath
+$@ = '';
$opt = eval {
XMLin('test2.xml', searchpath => [
'dir1', 'dir2', File::Spec->catdir('t', 'subdir')
] );
};
-print STDERR $@ if($@);
-ok(31, !$@); # XMLin didn't die
-ok(32, DataCompare($opt, { location => 't/subdir/test2.xml' }));
+is($@, '', 'XMLin found file using searchpath');
+is_deeply($opt, {
+ location => 't/subdir/test2.xml'
+}, 'and contents parsed as expected');
# Ensure we get expected result if file does not exist
+$@ = '';
+$opt = undef;
$opt = eval {
XMLin('bogusfile.xml', searchpath => [qw(. ./t)] ); # should 'die'
};
-ok(33, !defined($opt)); # XMLin failed
-ok(34, $@ =~ /Could not find bogusfile.xml in/); # with the expected message
+is($opt, undef, 'XMLin choked on nonexistant file');
+like($@, qr/Could not find bogusfile.xml in/, 'with the expected message');
# Try parsing from an IO::Handle
+$@ = '';
my $fh = new IO::File;
$XMLFile = File::Spec->catfile('t', '1_XMLin.xml'); # t/1_XMLin.xml
-$fh->open($XMLFile) || die "$!";
-$opt = XMLin($fh);
-ok(35, 1); # XMLin didn't die
-ok(36, $opt->{location}, 't/1_XMLin.xml'); # and it parsed the right file
+eval {
+ $fh->open($XMLFile) || die "$!";
+ $opt = XMLin($fh);
+};
+is($@, '', "XMLin didn't choke on an IO::File object");
+is($opt->{location}, 't/1_XMLin.xml', 'and it parsed the right file');
# Try parsing from STDIN
close(STDIN);
-open(STDIN, $XMLFile) || die "$!";
-$opt = XMLin('-');
-ok(37, $opt->{location}, 't/1_XMLin.xml'); # parsed the right file
+$@ = '';
+eval {
+ open(STDIN, $XMLFile) || die "$!";
+ $opt = XMLin('-');
+};
+is($@, '', "XMLin didn't choke on STDIN ('-')");
+is($opt->{location}, 't/1_XMLin.xml', 'and data parsed correctly');
-# Confirm anonymous array folding works in general
+# Confirm anonymous array handling works in general
$opt = XMLin(q(
<opt>
@@ -506,16 +429,16 @@
</row>
</opt>
));
-ok(38, DataCompare($opt, {
+is_deeply($opt, {
row => [
[ '0.0', '0.1', '0.2' ],
[ '1.0', '1.1', '1.2' ],
[ '2.0', '2.1', '2.2' ]
]
-}));
+}, 'anonymous arrays parsed correctly');
-# Confirm anonymous array folding works in special top level case
+# Confirm anonymous array handling works in special top level case
$opt = XMLin(q{
<opt>
@@ -524,9 +447,9 @@
<anon>three</anon>
</opt>
});
-ok(39, DataCompare($opt, [
+is_deeply($opt, [
qw(one two three)
-]));
+], 'top level anonymous array returned arrayref');
$opt = XMLin(q(
@@ -541,12 +464,12 @@
</anon>
</opt>
));
-ok(40, DataCompare($opt, [
+is_deeply($opt, [
1,
[
'2.1', [ '2.2.1', '2.2.2']
]
-]));
+], 'nested anonymous arrays parsed correctly');
# Check for the dreaded 'content' attribute
@@ -558,23 +481,23 @@
);
$opt = XMLin($xml);
-ok(41, DataCompare($opt, {
+is_deeply($opt, {
item => {
content => 'text',
attr => 'value'
}
-}));
+}, "'content' key appears as expected");
# And check that we can change its name if required
$opt = XMLin($xml, contentkey => 'text_content');
-ok(42, DataCompare($opt, {
+is_deeply($opt, {
item => {
text_content => 'text',
attr => 'value'
}
-}));
+}, "'content' key successfully renamed to 'text'");
# Check that it doesn't get screwed up by forcearray option
@@ -582,40 +505,40 @@
$xml = q(<opt attr="value">text content</opt>);
$opt = XMLin($xml, forcearray => 1);
-ok(43, DataCompare($opt, {
- 'attr' => 'value',
+is_deeply($opt, {
+ 'attr' => 'value',
'content' => 'text content'
-}));
+}, "'content' key not munged by forcearray");
# Test that we can force all text content to parse to hash values
$xml = q(<opt><x>text1</x><y a="2">text2</y></opt>);
$opt = XMLin($xml, forcecontent => 1);
-ok(44, DataCompare($opt, {
+is_deeply($opt, {
'x' => { 'content' => 'text1' },
'y' => { 'a' => 2, 'content' => 'text2' }
-}));
+}, 'gratuitous use of content key works as expected');
# And that this is compatible with changing the key name
$opt = XMLin($xml, forcecontent => 1, contentkey => '0');
-ok(45, DataCompare($opt, {
+is_deeply($opt, {
'x' => { 0 => 'text1' },
'y' => { 'a' => 2, 0 => 'text2' }
-}));
+}, "even when we change it's name to 'text'");
# Check that mixed content parses in the weird way we expect
$xml = q(<p class="mixed">Text with a <b>bold</b> word</p>);
-ok(46, DataCompare(XMLin($xml), {
+is_deeply(XMLin($xml), {
'class' => 'mixed',
'content' => [ 'Text with a ', ' word' ],
'b' => 'bold'
-}));
+}, "mixed content doesn't work - no surprises there");
# Confirm single nested element rolls up into a scalar attribute value
@@ -626,17 +549,17 @@
</opt>
);
$opt = XMLin($string);
-ok(47, DataCompare($opt, {
+is_deeply($opt, {
name => 'value'
-}));
+}, 'nested element rolls up to scalar');
# Unless 'forcearray' option is specified
$opt = XMLin($string, forcearray => 1);
-ok(48, DataCompare($opt, {
+is_deeply($opt, {
name => [ 'value' ]
-}));
+}, 'except when forcearray is enabled');
# Confirm array folding of single nested hash
@@ -646,17 +569,17 @@
</opt>);
$opt = XMLin($string, forcearray => 1);
-ok(49, DataCompare($opt, {
+is_deeply($opt, {
'inner' => { 'one' => { 'value' => 1 } }
-}));
+}, 'array folding works with single nested hash');
# But not without forcearray option specified
$opt = XMLin($string, forcearray => 0);
-ok(50, DataCompare($opt, {
+is_deeply($opt, {
'inner' => { 'name' => 'one', 'value' => 1 }
-}));
+}, 'but not if forcearray is turned off');
# Test advanced features of forcearray
@@ -671,12 +594,12 @@
);
$opt = XMLin($xml, forcearray => [ 'two' ]);
-ok(51, DataCompare($opt, {
+is_deeply($opt, {
'zero' => '0',
'one' => 'i',
'two' => [ 'ii' ],
'three' => [ 'iii', 3, 'c' ]
-}));
+}, 'selective application of forcearray successful');
# Test 'noattr' option
@@ -687,7 +610,7 @@
);
$opt = XMLin($xml, noattr => 1);
-ok(52, DataCompare($opt, { nest => 'text' }));
+is_deeply($opt, { nest => 'text' }, 'attributes successfully skipped');
# And make sure it doesn't screw up array folding
@@ -701,13 +624,13 @@
$opt = XMLin($xml, noattr => 1);
-ok(53, DataCompare($opt, {
+is_deeply($opt, {
'item' => {
'a' => { 'value' => 'alpha' },
'b' => { 'value' => 'beta' },
'g' => { 'value' => 'gamma' }
}
-}));
+}, 'noattr does not intefere with array folding');
# Confirm empty elements parse to empty hashrefs
@@ -721,42 +644,42 @@
</body>);
$opt = XMLin($xml, noattr => 1);
-ok(54, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => {},
'inner2' => {}
}
-}));
+}, 'empty elements parse to hashrefs');
# Unless 'suppressempty' is enabled
$opt = XMLin($xml, noattr => 1, suppressempty => 1);
-ok(55, DataCompare($opt, { 'name' => 'bob', }));
+is_deeply($opt, { 'name' => 'bob', }, 'or are suppressed');
# Check behaviour when 'suppressempty' is set to to undef;
$opt = XMLin($xml, noattr => 1, suppressempty => undef);
-ok(56, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => undef,
'inner2' => undef
}
-}));
+}, "or parse to 'undef'");
# Check behaviour when 'suppressempty' is set to to empty string;
$opt = XMLin($xml, noattr => 1, suppressempty => '');
-ok(57, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => '',
'inner2' => ''
}
-}));
+}, 'or parse to an empty string');
# Confirm completely empty XML parses to undef with 'suppressempty'
@@ -768,18 +691,21 @@
</body>);
$opt = XMLin($xml, noattr => 1, suppressempty => 1);
-ok(58, DataCompare($opt, undef));
+is($opt, undef, 'empty document parses to undef');
# Test option error handling
+$@='';
$_ = eval { XMLin('<x y="z" />', rootname => 'fred') }; # not valid for XMLin()
-ok(59, !defined($_));
-ok(60, $@ =~ /Unrecognised option:/);
+is($_, undef, 'invalid options are trapped');
+like($@, qr/Unrecognised option:/, 'with correct error message');
+$@='';
$_ = eval { XMLin('<x y="z" />', 'searchpath') };
-ok(61, !defined($_));
-ok(62, $@ =~ /Options must be name=>value pairs .odd number supplied./);
+is($_, undef, 'invalid number of options are trapped');
+like($@, qr/Options must be name=>value pairs \(odd number supplied\)/,
+'with correct error message');
# Now for a 'real world' test, try slurping in an SRT config file
@@ -868,7 +794,7 @@
}
}
};
-ok(63, DataCompare($target, $opt));
+is_deeply($target, $opt, 'successfully read an SRT config file');
exit(0);
Index: 2_XMLout.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/2_XMLout.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 2_XMLout.t 5 Feb 2002 22:28:31 -0000 1.3
+++ 2_XMLout.t 16 Oct 2002 09:43:35 -0000 1.4
@@ -1,89 +1,17 @@
# $Id$
+# vim: syntax=perl
use strict;
+use Test::More;
use IO::File;
-BEGIN { print "1..189\n"; }
-
-my $t = 1;
+plan tests => 172;
##############################################################################
# S U P P O R T R O U T I N E S
##############################################################################
##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
-
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
-}
-
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
-
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s) (", join(', ', keys(%$x)),
- "), got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
-}
-
-
-##############################################################################
# Read file and return contents as a scalar.
#
@@ -101,9 +29,9 @@
# Try encoding a scalar value
my $xml = XMLout("scalar");
-ok(1, 1); # XMLout did not crash
-ok(2, defined($xml)); # and it returned an XML string
-ok(3, XMLin($xml), 'scalar'); # which parses back OK
+ok(1, 'XMLout did not crash');
+ok(defined($xml), 'and it returned an XML string');
+is(XMLin($xml), 'scalar', 'which parses back OK');
# Next try encoding a hash
@@ -114,13 +42,12 @@
# Expect:
# <opt one="1" two="II" three="..." />
-$_ = XMLout($hashref1); # Encode to $_ for convenience
- # Confirm it parses back OK
-ok(4, DataCompare($hashref1, XMLin($_)));
-ok(5, s/one="1"//); # first key encoded OK
-ok(6, s/two="II"//); # second key encoded OK
-ok(7, s/three="..."//); # third key encoded OK
-ok(8, /^<\w+\s+\/>/); # no other attributes encoded
+$_ = XMLout($hashref1);
+is_deeply(XMLin($_), $hashref1, 'encoded a hash');
+ok(s/one="1"//, 'first key encoded OK');
+ok(s/two="II"//, 'second key encoded OK');
+ok(s/three="..."//, 'third key encoded OK');
+like($_, qr/^<\w+\s+\/>/, 'no other attributes encoded');
# Now try encoding a hash with a nested array
@@ -133,12 +60,12 @@
# <array>three</array>
# </opt>
-$_ = XMLout($ref); # Encode to $_ for convenience
-ok(9, DataCompare($ref, XMLin($_)));
-ok(10, s{<array>one</array>\s*
+$_ = XMLout($ref);
+is_deeply(XMLin($_), $ref, 'encoded a hash with nested array');
+ok(s{<array>one</array>\s*
<array>two</array>\s*
- <array>three</array>}{}sx); # array elements encoded in correct order
-ok(11, /^<(\w+)\s*>\s*<\/\1>\s*$/s); # no other spurious encodings
+ <array>three</array>}{}sx, 'array elements encoded in correct order');
+like($_, qr/^<(\w+)\s*>\s*<\/\1>\s*$/s, 'no other spurious encodings');
# Now try encoding a nested hash
@@ -153,11 +80,11 @@
# </opt>
$_ = XMLout($ref);
-ok(12, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded nested hashes');
-ok(13, s{<hash1 one="1" />\s*}{}s);
-ok(14, s{<hash2 two="2" />\s*}{}s);
-ok(15, m{^<(\w+)\s+value="555 1234"\s*>\s*</\1>\s*$}s);
+ok(s{<hash1 one="1" />\s*}{}s, 'nested hash 1 ok');
+ok(s{<hash2 two="2" />\s*}{}s, 'nested hash 2 ok');
+like($_, qr{^<(\w+)\s+value="555 1234"\s*>\s*</\1>\s*$}s, 'whole OK');
# Now try encoding an anonymous array
@@ -171,12 +98,14 @@
# </opt>
$_ = XMLout($ref);
-ok(16, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded anonymous array');
-ok(17, s{<anon>1</anon>\s*}{}s);
-ok(18, s{<anon>two</anon>\s*}{}s);
-ok(19, s{<anon>III</anon>\s*}{}s);
-ok(20, m{^<(\w+)\s*>\s*</\1>\s*$}s);
+like($_, qr{
+ ^<(\w+)\s*>
+ \s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*</\1>\s*$}sx, 'output matches expectations');
# Now try encoding a nested anonymous array
@@ -195,15 +124,20 @@
# </opt>
$_ = XMLout($ref);
-ok(21, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded nested anonymous arrays');
-ok(22, s{<anon>1\.1</anon>\s*}{row}s);
-ok(23, s{<anon>1\.2</anon>\s*}{ one}s);
-ok(24, s{<anon>2\.1</anon>\s*}{row}s);
-ok(25, s{<anon>2\.2</anon>\s*}{ two}s);
-ok(26, s{<anon>\s*row one\s*</anon>\s*}{}s);
-ok(27, s{<anon>\s*row two\s*</anon>\s*}{}s);
-ok(28, m{^<(\w+)\s*>\s*</\1>\s*$}s);
+like($_, qr{
+ <(\w+)\s*>
+ \s*<anon\s*>
+ \s*<anon\s*>1\.1</anon\s*>
+ \s*<anon\s*>1\.2</anon\s*>
+ \s*</anon\s*>
+ \s*<anon\s*>
+ \s*<anon\s*>2\.1</anon\s*>
+ \s*<anon\s*>2\.2</anon\s*>
+ \s*</anon\s*>
+ \s*</\1\s*>
+}sx, 'output matches expectations');
# Now try encoding a hash of hashes with key folding disabled
@@ -224,12 +158,12 @@
# </opt>
$_ = XMLout($ref, keyattr => []);
-ok(29, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(30, s{<England\s+capital="London"\s*/>\s*}{}s);
-ok(31, s{<France\s+capital="Paris"\s*/>\s*}{}s);
-ok(32, s{<Turkey\s+capital="Istanbul"\s*/>\s*}{}s);
-ok(33, s{<country\s*>\s*</country>}{}s);
-ok(34, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_), $ref, 'encoded hash of hashes with folding disabled');
+ok(s{<England\s+capital="London"\s*/>\s*}{}s, 'nested hash 1 ok');
+ok(s{<France\s+capital="Paris"\s*/>\s*}{}s, 'nested hash 2 ok');
+ok(s{<Turkey\s+capital="Istanbul"\s*/>\s*}{}s, 'nested hash 3 ok');
+ok(s{<country\s*>\s*</country>}{}s, 'container hash ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Try encoding same again with key folding set to non-standard value
@@ -243,41 +177,41 @@
$_ = XMLout($ref, keyattr => ['fullname']);
$xml = $_;
-ok(35, DataCompare($ref,
- XMLin($_, keyattr => ['fullname']))); # Parses back OK
-ok(36, s{\s*fullname="England"}{uk}s);
-ok(37, s{\s*capital="London"}{uk}s);
-ok(38, s{\s*fullname="France"}{fr}s);
-ok(39, s{\s*capital="Paris"}{fr}s);
-ok(40, s{\s*fullname="Turkey"}{tk}s);
-ok(41, s{\s*capital="Istanbul"}{tk}s);
-ok(42, s{<countryukuk\s*/>\s*}{}s);
-ok(43, s{<countryfrfr\s*/>\s*}{}s);
-ok(44, s{<countrytktk\s*/>\s*}{}s);
-ok(45, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_, keyattr => ['fullname']), $ref,
+'encoded hash of hashes with explicit folding enabled');
+ok(s{\s*fullname="England"}{uk}s, 'element 1 attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'element 1 attr 2 ok');
+ok(s{\s*fullname="France"}{fr}s, 'element 2 attr 1 ok');
+ok(s{\s*capital="Paris"}{fr}s, 'element 2 attr 2 ok');
+ok(s{\s*fullname="Turkey"}{tk}s, 'element 3 attr 1 ok');
+ok(s{\s*capital="Istanbul"}{tk}s, 'element 3 attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element 1 ok');
+ok(s{<countryfrfr\s*/>\s*}{}s, 'element 2 ok');
+ok(s{<countrytktk\s*/>\s*}{}s, 'element 2 ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Same again but specify name as scalar rather than array
$_ = XMLout($ref, keyattr => 'fullname');
-ok(46, $_ eq $xml); # Same result as last time
+is($_, $xml, 'still works when keyattr is scalar');
# Same again but specify keyattr as hash rather than array
$_ = XMLout($ref, keyattr => { country => 'fullname' });
-ok(47, $_ eq $xml); # Same result as last time
+is($_, $xml, 'still works when keyattr is array');
# Same again but add leading '+'
$_ = XMLout($ref, keyattr => { country => '+fullname' });
-ok(48, $_ eq $xml); # Same result as last time
+is($_, $xml, "still works when keyattr is hash with leading '+'");
# and leading '-'
$_ = XMLout($ref, keyattr => { country => '-fullname' });
-ok(49, $_ eq $xml); # Same result as last time
+is($_, $xml, "still works when keyattr is hash with leading '-'");
# One more time but with default key folding values
@@ -290,17 +224,18 @@
# </opt>
$_ = XMLout($ref);
-ok(50, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(51, s{\s*name="England"}{uk}s);
-ok(52, s{\s*capital="London"}{uk}s);
-ok(53, s{\s*name="France"}{fr}s);
-ok(54, s{\s*capital="Paris"}{fr}s);
-ok(55, s{\s*name="Turkey"}{tk}s);
-ok(56, s{\s*capital="Istanbul"}{tk}s);
-ok(57, s{<countryukuk\s*/>\s*}{}s);
-ok(58, s{<countryfrfr\s*/>\s*}{}s);
-ok(59, s{<countrytktk\s*/>\s*}{}s);
-ok(60, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_), $ref,
+'encoded hash of hashes with default folding enabled');
+ok(s{\s*name="England"}{uk}s, 'element 1 attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'element 1 attr 2 ok');
+ok(s{\s*name="France"}{fr}s, 'element 2 attr 1 ok');
+ok(s{\s*capital="Paris"}{fr}s, 'element 2 attr 2 ok');
+ok(s{\s*name="Turkey"}{tk}s, 'element 3 attr 1 ok');
+ok(s{\s*capital="Istanbul"}{tk}s, 'element 3 attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element 1 ok');
+ok(s{<countryfrfr\s*/>\s*}{}s, 'element 2 ok');
+ok(s{<countrytktk\s*/>\s*}{}s, 'element 2 ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Finally, confirm folding still works with only one nested hash
@@ -312,12 +247,11 @@
$ref = { country => { England => { capital => 'London' } } };
$_ = XMLout($ref);
-ok(61, DataCompare($ref, XMLin($_, forcearray => 1))); # Parses back OK
-ok(62, s{\s*name="England"}{uk}s);
-ok(63, s{\s*capital="London"}{uk}s);
-ok(64, s{<countryukuk\s*/>\s*}{}s);
-#print STDERR "\n$_\n";
-ok(65, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_, forcearray => 1), $ref, 'single nested hash unfolded');
+ok(s{\s*name="England"}{uk}s, 'attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Check that default XML declaration works
@@ -329,10 +263,9 @@
$ref = { one => 1 };
$_ = XMLout($ref, xmldecl => 1);
-ok(66, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(67, s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s);
-ok(68, s{<opt one="1" />}{}s);
-ok(69, m{^\s*$}s);
+is_deeply(XMLin($_), $ref, 'generated doc with XML declaration');
+ok(s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s, 'XML declaration OK');
+like($_, qr{^\s*<opt\s+one="1"\s*/>}s, 'data OK too');
# Check that custom XML declaration works
@@ -342,48 +275,48 @@
# <opt one="1" />
$_ = XMLout($ref, xmldecl => "<?xml version='1.0' standalone='yes'?>");
-ok(70, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(71, s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s);
-ok(72, s{<opt one="1" />}{}s);
-ok(73, m{^\s*$}s);
+is_deeply(XMLin($_), $ref, 'generated doc with custom XML declaration');
+ok(s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s, 'XML declaration OK');
+like($_, qr{^\s*<opt\s+one="1"\s*/>}s, 'data OK too');
# Check that special characters do get escaped
$ref = { a => '<A>', b => '"B"', c => '&C&' };
$_ = XMLout($ref);
-ok(74, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(75, s{a="<A>"}{}s);
-ok(76, s{b=""B""}{}s);
-ok(77, s{c="&C&"}{}s);
-ok(78, s{^<(\w+)\s*/>$}{}s);
+is_deeply(XMLin($_), $ref, 'generated document with escaping');
+ok(s{a="<A>"}{}s, 'angle brackets escaped OK');
+ok(s{b=""B""}{}s, 'double quotes escaped OK');
+ok(s{c="&C&"}{}s, 'ampersands escaped OK');
+ok(s{^<(\w+)\s*/>$}{}s, 'data OK too');
# unless we turn escaping off
$_ = XMLout($ref, noescape => 1);
-ok(79, s{a="<A>"}{}s);
-ok(80, s{b=""B""}{}s);
-ok(81, s{c="&C&"}{}s);
-ok(82, s{^<(\w+)\s*/>$}{}s);
+ok(s{a="<A>"}{}s, 'generated unescaped angle brackets');
+ok(s{b=""B""}{}s, 'generated unescaped double quotes');
+ok(s{c="&C&"}{}s, 'generated unescaped ampersands');
+ok(s{^<(\w+)\s*/>$}{}s, 'data OK too');
-# Try encoding a recursive data structure and confirm that it fails
+# Try encoding a circular data structure and confirm that it fails
$_ = eval {
my $ref = { a => '1' };
$ref->{b} = $ref;
XMLout($ref);
};
-ok(83, !defined($_));
-ok(84, $@ =~ /recursive data structures not supported/);
+ok(!defined($_), 'caught circular data structure');
+like($@, qr/circular data structures not supported/,
+'with correct error message');
# Try encoding a blessed reference and confirm that it fails
$_ = eval { my $ref = new IO::File; XMLout($ref) };
-ok(85, !defined($_));
-ok(86, $@ =~ /Can't encode a value of type: /);
+ok(!defined($_), 'caught blessed reference in data structure');
+like($@, qr/Can't encode a value of type: /, 'with correct error message');
# Repeat some of the above tests with named root element
@@ -391,10 +324,9 @@
# Try encoding a scalar value
$xml = XMLout("scalar", rootname => 'TOM');
-ok(87, defined($xml)); # and it returned an XML string
-ok(88, XMLin($xml), 'scalar'); # which parses back OK
- # and contains the expected data
-ok(89, $xml =~ /^\s*<TOM>scalar<\/TOM>\s*$/si);
+ok(defined($xml), 'generated document with named root element');
+is(XMLin($xml), 'scalar', 'parsed it back correctly');
+like($xml, qr/^\s*<TOM>scalar<\/TOM>\s*$/si, 'XML as expected');
# Next try encoding a hash
@@ -403,12 +335,11 @@
# <DICK one="1" two="II" three="..." />
$_ = XMLout($hashref1, rootname => 'DICK');
- # Confirm it parses back OK
-ok(90, DataCompare($hashref1, XMLin($_)));
-ok(91, s/one="1"//); # first key encoded OK
-ok(92, s/two="II"//); # second key encoded OK
-ok(93, s/three="..."//); # third key encoded OK
-ok(94, /^<DICK\s+\/>/); # only expected root element left
+is_deeply(XMLin($_), $hashref1, 'same again but encoded a hash');
+ok(s/one="1"//, 'first key encoded OK');
+ok(s/two="II"//, 'second key encoded OK');
+ok(s/three="..."//, 'third key encoded OK');
+like($_, qr/^<DICK\s+\/>/, 'XML looks OK');
# Now try encoding a hash with a nested array
@@ -421,12 +352,12 @@
# <array>three</array>
# </LARRY>
-$_ = XMLout($ref, rootname => 'LARRY'); # Encode to $_ for convenience
-ok(95, DataCompare($ref, XMLin($_)));
-ok(96, s{<array>one</array>\s*
+$_ = XMLout($ref, rootname => 'LARRY');
+is_deeply(XMLin($_), $ref, 'same again but with array in hash');
+ok(s{<array>one</array>\s*
<array>two</array>\s*
- <array>three</array>}{}sx); # array encoded in correct order
-ok(97, /^<(LARRY)\s*>\s*<\/\1>\s*$/s); # only expected root element left
+ <array>three</array>}{}sx, 'array encoded in correct order');
+like($_, qr/^<(LARRY)\s*>\s*<\/\1>\s*$/s, 'only expected root element left');
# Now try encoding a nested hash
@@ -441,11 +372,11 @@
# </CURLY>
$_ = XMLout($ref, rootname => 'CURLY');
-ok(98, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'same again but with nested hashes');
-ok(99, s{<hash1 one="1" />\s*}{}s);
-ok(100, s{<hash2 two="2" />\s*}{}s);
-ok(101, m{^<(CURLY)\s+value="555 1234"\s*>\s*</\1>\s*$}s);
+ok(s{<hash1 one="1" />\s*}{}s, 'hash 1 encoded OK');
+ok(s{<hash2 two="2" />\s*}{}s, 'hash 2 encoded OK');
+like($_, qr{^<(CURLY)\s+value="555 1234"\s*>\s*</\1>\s*$}s, 'document OK');
# Now try encoding an anonymous array
@@ -459,20 +390,23 @@
# </MOE>
$_ = XMLout($ref, rootname => 'MOE');
-ok(102, DataCompare($ref, XMLin($_))); # Parses back OK
-
-ok(103, s{<anon>1</anon>\s*}{}s);
-ok(104, s{<anon>two</anon>\s*}{}s);
-ok(105, s{<anon>III</anon>\s*}{}s);
-ok(106, m{^<(MOE)\s*>\s*</\1>\s*$}s);
+is_deeply(XMLin($_), $ref, 'same again but with nested anonymous array');
+like($_, qr{
+ ^<(MOE)\s*>
+ \s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*</\1>\s*$}sx, 'document OK');
# Test again, this time with no root element
# Try encoding a scalar value
-ok(107, XMLout("scalar", rootname => '') =~ /scalar\s+/s);
-ok(108, XMLout("scalar", rootname => undef) =~ /scalar\s+/s);
+like(XMLout("scalar", rootname => ''), qr/scalar\s+/s,
+ 'encoded scalar with no root element');
+like(XMLout("scalar", rootname => undef), qr/scalar\s+/s,
+ 'same again but with rootname = undef');
# Next try encoding a hash
@@ -483,12 +417,12 @@
# <three>...</three>
$_ = XMLout($hashref1, rootname => '');
- # Confirm it parses back OK
-ok(109, DataCompare($hashref1, XMLin("<opt>$_</opt>")));
-ok(110, s/<one>1<\/one>//); # first key encoded OK
-ok(111, s/<two>II<\/two>//); # second key encoded OK
-ok(112, s/<three>...<\/three>//); # third key encoded OK
-ok(113, /^\s*$/); # nothing else left
+is_deeply(XMLin("<opt>$_</opt>"), $hashref1,
+ 'generated doc with no root element from hash');
+ok(s/<one>1<\/one>//, 'first key encoded OK');
+ok(s/<two>II<\/two>//, 'second key encoded OK');
+ok(s/<three>...<\/three>//, 'third key encoded OK');
+like($_, qr/^\s*$/, 'document OK');
# Now try encoding a nested hash
@@ -502,11 +436,12 @@
# <hash2 two="2" />
$_ = XMLout($ref, rootname => '');
-ok(114, DataCompare($ref, XMLin("<opt>$_</opt>"))); # Parses back OK
-ok(115, s{<value>555 1234<\/value>\s*}{}s);
-ok(116, s{<hash1 one="1" />\s*}{}s);
-ok(117, s{<hash2 two="2" />\s*}{}s);
-ok(118, m{^\s*$}s);
+is_deeply(XMLin("<opt>$_</opt>"), $ref,
+ 'generated docucment with no root element from nested hashes');
+ok(s{<value>555 1234<\/value>\s*}{}s, 'first element OK');
+ok(s{<hash1 one="1" />\s*}{}s, 'second element OK');
+ok(s{<hash2 two="2" />\s*}{}s, 'third element OK');
+like($_, qr{^\s*$}s, 'document OK');
# Now try encoding an anonymous array
@@ -518,53 +453,57 @@
# <anon>III</anon>
$_ = XMLout($ref, rootname => '');
-ok(119, DataCompare($ref, XMLin("<opt>$_</opt>"))); # Parses back OK
-
-ok(120, s{<anon>1</anon>\s*}{}s);
-ok(121, s{<anon>two</anon>\s*}{}s);
-ok(122, s{<anon>III</anon>\s*}{}s);
-ok(123, m{^\s*$}s);
+is_deeply(XMLin("<opt>$_</opt>"), $ref,
+ 'generated doc with no root name from array');
+like($_, qr{
+ ^\s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*$}sx, 'document OK');
# Test option error handling
$_ = eval { XMLout($hashref1, searchpath => []) }; # only valid for XMLin()
-ok(124, !defined($_));
-ok(125, $@ =~ /Unrecognised option:/);
+ok(!defined($_), 'caught attempt to specify searchpath on XMLout');
+like($@, qr/Unrecognised option:/, 'with correct error message');
$_ = eval { XMLout($hashref1, 'bogus') };
-ok(126, !defined($_));
-ok(127, $@ =~ /Options must be name=>value pairs .odd number supplied./);
+ok(!defined($_), 'caught attempt to specify odd number of option args');
+like($@, qr/Options must be name=>value pairs \(odd number supplied\)/,
+ 'with correct error message');
# Test output to file
my $TestFile = 'testoutput.xml';
unlink($TestFile);
-ok(128, !-e $TestFile);
+ok(!-e $TestFile, 'output file does not exist');
$xml = XMLout($hashref1);
-XMLout($hashref1, outputfile => $TestFile);
-ok(129, -e $TestFile);
-ok(130, ReadFile($TestFile) eq $xml);
+eval { XMLout($hashref1, outputfile => $TestFile); };
+ok(-e $TestFile, 'created xml output file');
+is(ReadFile($TestFile), $xml, 'Contents match expectations');
unlink($TestFile);
# Test output to an IO handle
-ok(131, !-e $TestFile);
+ok(!-e $TestFile);
my $fh = new IO::File;
-$fh->open(">$TestFile") || die "$!";
-XMLout($hashref1, outputfile => $TestFile);
-$fh->close();
-ok(132, -e $TestFile);
-ok(133, ReadFile($TestFile) eq $xml);
+eval {
+ $fh->open(">$TestFile") || die "$!";
+ XMLout($hashref1, outputfile => $TestFile);
+ $fh->close();
+};
+ok(-e $TestFile, 'create XML output file via IO::File');
+is(ReadFile($TestFile), $xml, 'Contents match expectations');
unlink($TestFile);
# After all that, confirm that the original hashref we supplied has not
# been corrupted.
-ok(134, DataCompare($hashref1, $hashref2));
+is_deeply($hashref1, $hashref2, 'original data not corrupted');
# Confirm that hash keys with leading '-' are skipped
@@ -579,7 +518,7 @@
};
$_ = XMLout($ref, rootname => 'opt');
-ok(135, m{^\s*<opt\s+a="one"\s*/>\s*$}s);
+like($_, qr{^\s*<opt\s+a="one"\s*/>\s*$}s, "skipped hashkeys with '-' prefix");
# Try a more complex unfolding with key attributes named in a hash
@@ -618,33 +557,35 @@
# </opt>
$_ = XMLout($ref, keyattr => { 'car' => 'license', 'option' => 'pn' });
-ok(136, DataCompare($ref, # Parses back OK
- XMLin($_, forcearray => 1,
- keyattr => { 'car' => 'license', 'option' => 'pn' })));
-ok(137, s{\s*make="GM"}{gm}s);
-ok(138, s{\s*id="2"}{gm}s);
-ok(139, s{\s*license="LW1804"}{gm}s);
-ok(140, s{\s*desc="Steering Wheel"}{opt}s);
-ok(141, s{\s*pn="9926543-1167"}{opt}s);
-ok(142, s{\s*key="1"}{opt}s);
-ok(143, s{\s*<cargmgmgm>\s*<optionoptoptopt\s*/>\s*</car>}{CAR}s);
-ok(144, s{\s*make="Ford"}{ford}s);
-ok(145, s{\s*id="1"}{ford}s);
-ok(146, s{\s*license="SH6673"}{ford}s);
-ok(147, s{\s*desc="Electric Windows"}{1}s);
-ok(148, s{\s*pn="6389733317-12"}{1}s);
-ok(149, s{\s*key="2"}{1}s);
-ok(150, s{\s*<option111}{<option}s);
-ok(151, s{\s*desc="Leather Seats"}{2}s);
-ok(152, s{\s*pn="3735498158-01"}{2}s);
-ok(153, s{\s*key="3"}{2}s);
-ok(154, s{\s*<option222}{<option}s);
-ok(155, s{\s*desc="Sun Roof"}{3}s);
-ok(156, s{\s*pn="5776155953-25"}{3}s);
-ok(157, s{\s*key="4"}{3}s);
-ok(158, s{\s*<option333}{<option}s);
-ok(159, s{\s*<carfordfordford>\s*(<option\s*/>\s*){3}</car>}{CAR}s);
-ok(160, s{^<(\w+)\s*>\s*CAR\s*CAR\s*</\1>$}{}s);
+is_deeply(XMLin($_,
+ forcearray => 1,
+ keyattr => { 'car' => 'license', 'option' => 'pn' }
+), $ref, 'generated document from complex nested hash with unfolding');
+ok(s{\s*make="GM"}{gm}s, 'element 1 attribute 1 OK');
+ok(s{\s*id="2"}{gm}s, 'element 1 attribute 2 OK');
+ok(s{\s*license="LW1804"}{gm}s, 'element 1 attribute 3 OK');
+ok(s{\s*desc="Steering Wheel"}{opt}s, 'element 1.1 attribute 1 OK');
+ok(s{\s*pn="9926543-1167"}{opt}s, 'element 1.1 attribute 2 OK');
+ok(s{\s*key="1"}{opt}s, 'element 1.1 attribute 3 OK');
+ok(s{\s*<cargmgmgm>\s*<optionoptoptopt\s*/>\s*</car>}{CAR}s,
+ 'elements 1 and 1.1 OK');
+ok(s{\s*make="Ford"}{ford}s, 'element 2 attribute 1 OK');
+ok(s{\s*id="1"}{ford}s, 'element 2 attribute 2 OK');
+ok(s{\s*license="SH6673"}{ford}s, 'element 2 attribute 3 OK');
+ok(s{\s*desc="Electric Windows"}{1}s, 'element 2.1 attribute 1 OK');
+ok(s{\s*pn="6389733317-12"}{1}s, 'element 2.1 attribute 2 OK');
+ok(s{\s*key="2"}{1}s, 'element 2.1 attribute 3 OK');
+ok(s{\s*<option111}{<option}s, 'element 2.1 OK');
+ok(s{\s*desc="Leather Seats"}{2}s, 'element 2.2 attribute 1 OK');
+ok(s{\s*pn="3735498158-01"}{2}s, 'element 2.2 attribute 2 OK');
+ok(s{\s*key="3"}{2}s, 'element 2.2 attribute 3 OK');
+ok(s{\s*<option222}{<option}s, 'element 2.2 OK');
+ok(s{\s*desc="Sun Roof"}{3}s, 'element 2.3 attribute 1 OK');
+ok(s{\s*pn="5776155953-25"}{3}s, 'element 2.3 attribute 2 OK');
+ok(s{\s*key="4"}{3}s, 'element 2.3 attribute 3 OK');
+ok(s{\s*<option333}{<option}s, 'element 2.3 OK');
+ok(s{\s*<carfordfordford>\s*(<option\s*/>\s*){3}</car>}{CAR}s, 'element 2 OK');
+ok(s{^<(\w+)\s*>\s*CAR\s*CAR\s*</\1>$}{}s, 'document OK');
# Check that empty hashes translate to empty tags
@@ -659,33 +600,34 @@
};
$_ = XMLout($ref);
-
-ok(161, s{<nest2\s*></nest2\s*>\s*}{<NNN>});
-ok(162, s{<nest1\s*>nvalue1</nest1\s*>\s*}{<NNN>});
-ok(163, s{<one\s*attr1\s*=\s*"avalue1">\s*}{<one>});
-ok(164, s{<one\s*>\s*<NNN>\s*<NNN>\s*</one>}{<nnn>});
-ok(165, s{<two\s*></two\s*>\s*}{<nnn>});
-ok(166, m{^\s*<(\w+)\s*>\s*<nnn>\s*<nnn>\s*</\1\s*>\s*$});
+ok(s{<nest2\s*></nest2\s*>\s*}{<NNN>}, 'nested empty hash OK');
+ok(s{<nest1\s*>nvalue1</nest1\s*>\s*}{<NNN>}, 'array OK');
+ok(s{<one\s*attr1\s*=\s*"avalue1">\s*}{<one>}, 'scalar OK');
+ok(s{<one\s*>\s*<NNN>\s*<NNN>\s*</one>}{<nnn>}, 'nesting OK');
+ok(s{<two\s*></two\s*>\s*}{<nnn>}, 'empty hash OK');
+like($_, qr{^\s*<(\w+)\s*>\s*<nnn>\s*<nnn>\s*</\1\s*>\s*$}, 'document OK');
# Check undefined values generate warnings
{
-my $warn = '';
-local $SIG{__WARN__} = sub { $warn = $_[0] };
-$_ = eval {
- $ref = { 'tag' => undef };
- XMLout($ref);
-};
-ok(167, $warn =~ /Use of uninitialized value/);
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ $_ = eval {
+ $ref = { 'tag' => undef };
+ XMLout($ref);
+ };
+ like($warn, qr/Use of uninitialized value/,
+ 'caught warning re uninitialised value');
}
-# Unless undef is mapped to empty tags
+# Unless undef is mapped to empty elements
$ref = { 'tag' => undef };
$_ = XMLout($ref, suppressempty => undef);
-ok(168, m{^\s*<(\w*)\s*>\s*<tag\s*></tag\s*>\s*</\1\s*>\s*$}s);
+like($_, qr{^\s*<(\w*)\s*>\s*<tag\s*></tag\s*>\s*</\1\s*>\s*$}s,
+ 'uninitialiased values successfully mapped to empty elements');
# Test the keeproot option
@@ -700,7 +642,7 @@
my $xml1 = XMLout($ref, rootname => 'sequence');
my $xml2 = XMLout({ 'sequence' => $ref }, keeproot => 1);
-ok(169, DataCompare($xml1, $xml2));
+is_deeply($xml1, $xml2, 'keeproot works as expected');
# Test that items with text content are output correctly
@@ -710,7 +652,7 @@
$_ = XMLout($ref);
-ok(170, m{^\s*<opt\s+one="1">text</opt>\s*$}s);
+like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'content keys mapped OK');
# Even if we change the default value for the 'contentkey' option
@@ -719,7 +661,7 @@
$_ = XMLout($ref, contentkey => 'text_content');
-ok(171, m{^\s*<opt\s+one="1">text</opt>\s*$}s);
+like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'even when name changed');
# Check 'noattr' option
@@ -743,12 +685,13 @@
$_ = XMLout($ref, noattr => 1);
-ok(172, !m{=}s); # No '=' signs anywhere
-ok(173, DataCompare($ref, XMLin($_))); # Parses back ok
-ok(174, s{\s*<(attr1)>value1</\1>\s*}{NEST}s); # Output meets expectations
-ok(175, s{\s*<(attr2)>value2</\1>\s*}{NEST}s);
-ok(176, s{\s*<(nest)>one</\1>\s*<\1>two</\1>\s*<\1>three</\1>}{NEST}s);
-ok(177, s{^<(\w+)\s*>(NEST\s*){3}</\1>$}{}s);
+unlike($_, qr{=}s, 'generated document with no attributes');
+is_deeply(XMLin($_), $ref, 'parses ok');
+ok(s{\s*<(attr1)>value1</\1>\s*}{NEST}s, 'scalar 1 mapped ok');
+ok(s{\s*<(attr2)>value2</\1>\s*}{NEST}s, 'scalar 2 mapped ok');
+ok(s{\s*<(nest)>one</\1>\s*<\1>two</\1>\s*<\1>three</\1>}{NEST}s,
+'array mapped ok');
+like($_, qr{^<(\w+)\s*>(NEST\s*){3}</\1>$}s, 'document OK');
# Check noattr doesn't screw up keyattr
@@ -777,18 +720,17 @@
$_ = XMLout($ref, noattr => 1, keyattr => [ 'word' ]);
-ok(178, !m{=}s); # No '=' signs anywhere
- # Parses back ok
-ok(179, DataCompare($ref, XMLin($_, keyattr => [ 'word' ])));
-ok(180, s{\s*<(dec)>21</\1>\s*}{21}s);
-ok(181, s{\s*<(hex)>0x15</\1>\s*}{21}s);
-ok(182, s{\s*<(word)>twenty one</\1>\s*}{21}s);
-ok(183, s{\s*<(number)>212121</\1>\s*}{NUM}s);
-ok(184, s{\s*<(dec)>32</\1>\s*}{32}s);
-ok(185, s{\s*<(hex)>0x20</\1>\s*}{32}s);
-ok(186, s{\s*<(word)>thirty two</\1>\s*}{32}s);
-ok(187, s{\s*<(number)>323232</\1>\s*}{NUM}s);
-ok(188, s{^<(\w+)\s*>NUMNUM</\1>$}{}s);
+unlike($_, qr{=}s, 'same again but with unfolding too');
+is_deeply(XMLin($_, keyattr => [ 'word' ]), $ref, 'parsed OK');
+ok(s{\s*<(dec)>21</\1>\s*}{21}s, 'scalar 1.1 mapped OK');
+ok(s{\s*<(hex)>0x15</\1>\s*}{21}s, 'scalar 1.2 mapped OK');
+ok(s{\s*<(word)>twenty one</\1>\s*}{21}s, 'scalar 1.3 mapped OK');
+ok(s{\s*<(number)>212121</\1>\s*}{NUM}s, 'element 1 OK');
+ok(s{\s*<(dec)>32</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
+ok(s{\s*<(hex)>0x20</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
+ok(s{\s*<(word)>thirty two</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
+ok(s{\s*<(number)>323232</\1>\s*}{NUM}s, 'element 2 OK');
+like($_, qr{^<(\w+)\s*>NUMNUM</\1>$}, 'document OK');
# 'Stress test' with a data structure that maps to several thousand elements.
@@ -806,12 +748,9 @@
my $opt2 = XMLin($xml, keyattr => { TypeA => 'alpha', TypeB => 'beta', Record => 'id' }, forcearray => 1);
-ok(189, DataCompare($opt1, $opt2));
+is_deeply($opt1, $opt2, 'large datastructure mapped to XML and back OK');
exit(0);
-
-
-
Index: 3_Storable.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/3_Storable.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- 3_Storable.t 14 Feb 2002 21:33:44 -0000 1.4
+++ 3_Storable.t 16 Oct 2002 09:43:35 -0000 1.5
@@ -1,14 +1,13 @@
# $Id$
+# vim: syntax=perl
use strict;
-
+use Test::More;
use File::Spec;
eval { require Storable; };
unless($INC{'Storable.pm'}) {
- print STDERR "no Storable.pm...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'no Storable.pm';
}
# Initialise filenames and check they're there
@@ -18,91 +17,30 @@
my $CacheFile = File::Spec->catfile('t', 'desertnet.stor');
unless(-e $SrcFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'test data missing';
}
-print "1..19\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
+# Make sure we can write to the filesystem and check it uses the same
+# clock as the machine we're running on.
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
+my $t0 = time();
+unless(open(XML, ">$XMLFile")) {
+ plan skip_all => "can't create test file: $!";
}
+close(XML);
+my $t1 = (stat($XMLFile))[9];
+my $t2 = time();
+if($t1 < $t0 or $t2 < $t1) {
+ plan skip_all => 'time moved backwards!'
+}
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s) (", join(', ', keys(%$x)),
- "), got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
-}
+plan tests => 20;
+##############################################################################
+# S U P P O R T R O U T I N E S
+##############################################################################
##############################################################################
# Copy a file
@@ -171,25 +109,25 @@
}
};
-ok(1, CopyFile($SrcFile, $XMLFile)); # Start with known source file
-unlink($CacheFile); # Ensure there are ...
-ok(2, ! -e $CacheFile); # ... no cache files lying around
+ok(CopyFile($SrcFile, $XMLFile), 'copied known good source file');
+unlink($CacheFile);
+ok(! -e $CacheFile, 'no cache files lying around');
my $opt = XMLin($XMLFile);
-ok(3, DataCompare($opt, $Expected)); # Got what we expected
-ok(4, ! -e $CacheFile); # And no cache file was created
+is_deeply($opt, $Expected, 'parsed expected data from file');
+ok(! -e $CacheFile, 'and no cache file was created');
PassTime(time()); # Ensure cache file will be newer
$opt = XMLin($XMLFile, cache => 'storable');
-ok(5, DataCompare($opt, $Expected)); # Got what we expected again
-ok(6, -e $CacheFile); # But this time a cache file was created
-my $t0 = (stat($CacheFile))[9]; # Remember cache timestamp
+is_deeply($opt, $Expected, 'parsed expected data from file (again)');
+ok(-e $CacheFile, 'but this time a cache file was created');
+$t0 = (stat($CacheFile))[9]; # Remember cache timestamp
PassTime($t0);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(7, DataCompare($opt, $Expected)); # Got what we expected from the cache
-my $t1 = (stat($CacheFile))[9]; # Check cache timestamp
-ok(8, $t0, $t1); # has not changed
+is_deeply($opt, $Expected, 'got expected data from cache');
+$t1 = (stat($CacheFile))[9];
+is($t0, $t1, 'and cache timestamp has not changed');
PassTime(time());
$t0 = time();
@@ -197,20 +135,21 @@
print FILE "\n";
close(FILE);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(9, DataCompare($opt, $Expected)); # Got what we expected
-my $t2 = (stat($CacheFile))[9]; # Check cache timestamp
-ok(10, $t1 != $t2); # has changed
+is_deeply($opt, $Expected, 'parsed in expected value again');
+$t2 = (stat($CacheFile))[9];
+isnt($t1, $t2, 'and this time the cache timestamp has changed');
unlink($XMLFile);
-ok(11, ! -e $XMLFile); # Original XML file is gone
+ok(! -e $XMLFile, 'deleted the cache file');
open(FILE, ">$XMLFile"); # Re-create it (empty)
close(FILE);
+ok(-e $XMLFile, 'recreated the source file');
+is(-s $XMLFile, 0, 'but with nothing in it');
PassTime((stat($XMLFile))[9]); # But ensure cache file is newer
unlink($CacheFile); # Seems to be rqd for test on Win32
Storable::nstore($Expected, $CacheFile);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(12, DataCompare($opt, $Expected)); # Got what we expected from the cache
-ok(13, ! -s $XMLFile); # even though the XML file is empty
+is_deeply($opt, $Expected, 'got the expected data from the cache');
$t2 = (stat($CacheFile))[9];
PassTime($t2);
open(FILE, ">$XMLFile") || # Write some new data to the XML file
@@ -219,23 +158,23 @@
close(FILE);
$opt = XMLin($XMLFile); # Parse with no caching
-ok(14, DataCompare($opt, { one => 1, two => 2})); # Got what we expected
+is_deeply($opt, { one => 1, two => 2}, 'parsed in expected data from file');
$t0 = (stat($CacheFile))[9]; # And timestamp on cache file
my $s0 = (-s $CacheFile);
-ok(15, $t0 == $t2); # has not changed
+is($t0, $t2, 'and the cache file was not touched');
# Parse again with caching enabled
$opt = XMLin($XMLFile, cache => 'storable');
- # Came through the cache
-ok(16, DataCompare($opt, { one => 1, two => 2}));
-$t1 = (stat($CacheFile))[9]; # which has been updated
+is_deeply($opt, { one => 1, two => 2}, 'parsed expected data through cache');
+$t1 = (stat($CacheFile))[9];
my $s1 = (-s $CacheFile);
-ok(17, ($t0 != $t1) || ($s0 != $s1)); # Content changes but date may not on Win32
+ok(($t0 != $t1) || ($s0 != $s1),
+'and the cache was updated'); # Content changes but date may not on Win32
-ok(18, CopyFile($SrcFile, $XMLFile)); # Put back the original file
+ok(CopyFile($SrcFile, $XMLFile), 'copied back the original file');
PassTime($t1);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(19, DataCompare($opt, $Expected)); # Got what we expected
+is_deeply($opt, $Expected, 'parsed expected data in through cache');
# Clean up and go
Index: 4_MemShare.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/4_MemShare.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 4_MemShare.t 5 Feb 2002 22:28:31 -0000 1.2
+++ 4_MemShare.t 16 Oct 2002 09:43:35 -0000 1.3
@@ -1,7 +1,8 @@
# $Id$
+# vim: syntax=perl
use strict;
-
+use Test::More;
use File::Spec;
# Initialise filenames and check they're there
@@ -10,91 +11,30 @@
my $XMLFile = File::Spec->catfile('t', 'desertnet.xml');
unless(-e $SrcFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'test data missing';
}
-print "1..7\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
+# Make sure we can write to the filesystem and check it uses the same
+# clock as the machine we're running on.
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
+my $t0 = time();
+unless(open(XML, ">$XMLFile")) {
+ plan skip_all => "can't create test file: $!";
}
+close(XML);
+my $t1 = (stat($XMLFile))[9];
+my $t2 = time();
+if($t1 < $t0 or $t2 < $t1) {
+ plan skip_all => 'time moved backwards!'
+}
-##############################################################################
-# Take two scalar values (may be references) and compare them (r...
[truncated message content] |
