Menu
▾
▴
[perl-xml-cvs] CVS: xml-filter-nsnormalise/t 1_basic.t,1.2,1.3 2_more.t,1.3,1.4
|
From: Grant M. <gr...@us...> - 2002-10-11 02:00:48
|
Update of /cvsroot/perl-xml/xml-filter-nsnormalise/t
In directory usw-pr-cvs1:/tmp/cvs-serv11705/t
Modified Files:
1_basic.t 2_more.t
Log Message:
- added better diagnostics to trap test failures
Index: 1_basic.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-filter-nsnormalise/t/1_basic.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 1_basic.t 10 Oct 2002 21:36:13 -0000 1.2
+++ 1_basic.t 11 Oct 2002 02:00:46 -0000 1.3
@@ -10,9 +10,62 @@
##############################################################################
-# Confirm that the module compiles
+# Print out a list of installed modules and their version numbers
#
+eval {
+
+ my @mod_list = qw(
+ XML::SAX XML::SAX::Writer XML::NamespaceSupport
+ );
+
+
+ # If XML::SAX is installed, add a list of installed SAX parsers
+
+ eval { require XML::SAX; };
+ my $default_parser = '';
+ unless($@) {
+ push @mod_list, map { $_->{Name} } @{XML::SAX->parsers()};
+ $default_parser = ref(XML::SAX::ParserFactory->parser());
+ }
+
+
+ # Extract the version number from each module
+
+ my(%version);
+ foreach my $module (@mod_list) {
+ eval " require $module; ";
+ unless($@) {
+ no strict 'refs';
+ $version{$module} = ${$module . '::VERSION'} || "Unknown";
+ }
+ }
+
+
+ # Add version number of the Perl binary
+
+ eval ' use Config; $version{perl} = $Config{version} '; # Should never fail
+ if($@) {
+ $version{perl} = $];
+ }
+ unshift @mod_list, 'perl';
+
+
+ # Print details of installed modules on STDERR
+
+ diag(sprintf("\r%-30s %s", 'Package', 'Version'));
+ foreach my $module (@mod_list) {
+ $version{$module} = 'Not Installed' unless(defined($version{$module}));
+ $version{$module} .= " (default parser)" if($module eq $default_parser);
+ printf STDERR " %-30s %s\n", $module, $version{$module};
+ }
+
+};
+
+
+##############################################################################
+# Confirm that the module compiles
+
use XML::Filter::NSNormalise
ok(1, 'XML::Filter::NSNormalise compiled OK');
@@ -47,7 +100,7 @@
);
};
-ok($@ =~ /Multiple URIs mapped to prefix 'dc'/, "Caught many to one mapping");
+like($@, qr/Multiple URIs mapped to prefix 'dc'/, "Caught many to one mapping");
##############################################################################
@@ -58,6 +111,6 @@
XML::Filter::NSNormalise->new();
};
-ok($@ =~ /No 'Map' option in call to XML::Filter::NSNormalise->new/,
+like($@, qr/No 'Map' option in call to XML::Filter::NSNormalise->new/,
"Caught missing 'Map' option");
Index: 2_more.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-filter-nsnormalise/t/2_more.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 2_more.t 10 Oct 2002 21:36:13 -0000 1.3
+++ 2_more.t 11 Oct 2002 02:00:46 -0000 1.4
@@ -63,6 +63,7 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
ok(ref($p), 'Created a parser object');
+$@ = '';
eval {$p->parse_string(q{
<rdf:RDF
xmlns="http://purl.org/rss/1.0/"
@@ -72,7 +73,7 @@
</rdf:RDF>
});
};
-ok(!$@, 'Parsed with no errors');
+is($@, '', 'Parsed with no errors');
ok($xml =~ s{xmlns=('|")http://purl\.org/rss/1\.0/\1}{ATTR},
"Default namespace declaration untouched");
@@ -83,7 +84,7 @@
ok($xml =~ s{xmlns:dc=('|")http://purl.org/dc/elements/1.1/\1}{ATTR},
"DC namespace declaration mapped successfully");
-ok($xml =~ m{
+like($xml, qr{
^\s* # optional leading whitespace
<rdf:RDF\s+ATTR\s+ATTR\s+ATTR # root element with three ns attrs
\s*> # end the tag
@@ -110,6 +111,7 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
+$@ = '';
eval {$p->parse_string(q{
<doc xmlns:alpha="companya.com" xmlns:beta="companyb.com">
<ignore>Does nothing</ignore>
@@ -118,7 +120,7 @@
</doc>
});
};
-ok(!$@, 'Parsed namespaced attributes with no errors');
+is($@, '', 'Parsed namespaced attributes with no errors');
ok($xml =~ s{xmlns:a=('|")companya.com\1}{ATTR},
"Company A namespace declaration mapped successfully");
@@ -136,7 +138,7 @@
ok($xml =~ s{\s+b:align=('|")right\1}{ ATTR_B},
"Company B namespaced attribute mapped successfully");
-ok($xml =~ m{
+like($xml, qr{
^\s* # optional leading whitespace
<doc\s+ATTR\s+ATTR\s*> # root element with two ns attrs
\s+<ignore>Does\snothing</ignore> # innocent bystander
@@ -164,6 +166,7 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
+$@ = '';
eval {$p->parse_string(q{
<doc xmlns:alpha="companya.com" xmlns:a="aardvark.com">
<alpha:para>paragraph one</alpha:para>
@@ -172,7 +175,7 @@
});
};
-ok($@ =~ /Cannot map 'companya\.com' to 'a' - prefix already occurs in document/,
+like($@, qr/Cannot map 'companya\.com' to 'a' - prefix already occurs in document/,
'Caught attempt to map to a used prefix');
@@ -193,6 +196,7 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
+$@ = '';
eval {$p->parse_string(q{
<doc xmlns:a="companya.com" xmlns:aa="aardvark.com">
<a:para>paragraph one</a:para>
@@ -201,7 +205,7 @@
});
};
-ok(!$@, 'Mapping to same prefix succeeded');
+is($@, '', 'Mapping to same prefix succeeded');
ok($xml =~ s{xmlns:a=('|")companya.com\1}{ATTR},
"Original 'a' prefix declaration mapped successfully to itself");
@@ -209,7 +213,7 @@
ok($xml =~ s{xmlns:aa=('|")aardvark.com\1}{ATTR},
"Original 'aa' prefix declaration survived unscathed");
-ok($xml =~ m{
+like($xml, qr{
^\s* # optional leading whitespace
<doc\s+ATTR\s+ATTR\s*> # root element with two ns attrs
\s+<a:para\s*>paragraph\sone</a:para>
@@ -236,13 +240,14 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
+$@ = '';
eval {$p->parse_string(q{
<doc xmlns="companya.com">
<para>paragraph one</para>
</doc>
});
};
-ok(!$@, 'Parsed mapped default namespace with no errors');
+is($@, '', 'Parsed mapped default namespace with no errors');
ok($xml =~ s{xmlns=('|")companya.com\1}{ATTR},
"Default namespace declaration mapped successfully");
@@ -250,7 +255,7 @@
ok($xml =~ s{xmlns:a=('|")companya.com\1}{ATTR},
"Explicit namespace prefix declaration added");
-ok($xml =~ m{
+like($xml, qr{
^\s* # optional leading whitespace
<a:doc\s+ATTR\s+ATTR\s*> # root element with two ns attrs
\s+<a:para\s*>paragraph\sone</a:para>
@@ -276,6 +281,7 @@
my $p = XML::SAX::ParserFactory->parser(Handler => $filter);
+$@ = '';
eval {$p->parse_string(q{
<doc xmlns="companya.com">
<para>paragraph one</para>
@@ -288,7 +294,7 @@
</doc>
});
};
-ok(!$@, 'Parsed nested default namespaces with no errors');
+is($@, '', 'Parsed nested default namespaces with no errors');
ok($xml =~ s{xmlns=('|")companya.com\1}{ATTR_A},
"Default namespace declaration mapped successfully");
@@ -304,9 +310,8 @@
ok($xml =~ s{xmlns=('|")companyc.com\1}{ATTR_C},
"Default namespace declaration mapped successfully");
-#print "$xml\n";
-ok($xml =~ m{
+like($xml, qr{
^\s* # optional leading whitespace
<a:doc\s+ATTR_A\s+ATTR_A\s*> # root element with two ns attrs
\s+<a:para\s*>paragraph\sone</a:para>
|
