diff options
author | James Raspass <jraspass@gmail.com> | 2022-08-21 20:48:21 +0100 |
---|---|---|
committer | Olaf Alders <olaf@wundersolutions.com> | 2022-08-22 08:26:51 -0400 |
commit | d58d34967abc31ad7d22a71aa5e15d407d77799a (patch) | |
tree | 68fb1ea013aa4f496a9267260e38b533146572c6 | |
parent | 9cc1f62cb927c7a022f3f3b0d30c6e3f9a06a924 (diff) | |
download | uri-d58d34967abc31ad7d22a71aa5e15d407d77799a.tar.gz |
Replace raw TAP printing with "Test::More"
-rw-r--r-- | Changes | 1 | ||||
-rw-r--r-- | t/abs.t | 14 | ||||
-rw-r--r-- | t/clone.t | 8 | ||||
-rw-r--r-- | t/data.t | 74 | ||||
-rw-r--r-- | t/ftp.t | 41 | ||||
-rw-r--r-- | t/generic.t | 152 | ||||
-rw-r--r-- | t/gopher.t | 14 | ||||
-rw-r--r-- | t/heuristic.t | 86 | ||||
-rw-r--r-- | t/http.t | 50 | ||||
-rw-r--r-- | t/ldap.t | 96 | ||||
-rw-r--r-- | t/mix.t | 52 | ||||
-rw-r--r-- | t/mms.t | 26 | ||||
-rw-r--r-- | t/news.t | 51 | ||||
-rw-r--r-- | t/old-absconf.t | 20 | ||||
-rw-r--r-- | t/old-file.t | 15 | ||||
-rw-r--r-- | t/old-relbase.t | 20 | ||||
-rw-r--r-- | t/pop.t | 40 | ||||
-rw-r--r-- | t/rsync.t | 14 | ||||
-rw-r--r-- | t/rtsp.t | 29 | ||||
-rw-r--r-- | t/sip.t | 66 | ||||
-rw-r--r-- | t/split.t | 53 | ||||
-rw-r--r-- | t/storable-test.pl | 13 | ||||
-rw-r--r-- | t/storable.t | 1 | ||||
-rw-r--r-- | t/urn-isbn.t | 46 | ||||
-rw-r--r-- | t/urn-oid.t | 14 |
25 files changed, 361 insertions, 635 deletions
@@ -5,6 +5,7 @@ Revision history for URI file() method of URI::file can return the current working directory instead of the properly unescaped path. (GH#106) (Perlbotics) - Replace "Test" with "Test::More" (GH#107) (James Raspass) + - Replace raw TAP printing with "Test::More" (GH#108) (James Raspass) 5.12 2022-07-10 23:48:50Z - Fix an issue where i.e. 'file:///tmp/###' was not properly escaped. @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..45\n"; +use Test::More tests => 45; # This test the resolution of abs path for all examples given # in the "Uniform Resource Identifiers (URI): Generic Syntax" document. @@ -18,14 +18,13 @@ while (<DATA>) { my $uref = $1; my $expect = $2; $expect =~ s/\(current document\)/$base/; - #print "$uref => $expect\n"; my $bad; my $u = URI->new($uref, $base); if ($u->abs($base)->as_string ne $expect) { $bad++; my $abs = $u->abs($base)->as_string; - print qq(URI->new("$uref")->abs("$base") ==> "$abs"\n); + diag qq(URI->new("$uref")->abs("$base") ==> "$abs"); } # Let's test another version of the same thing @@ -33,7 +32,7 @@ while (<DATA>) { my $b = URI->new($base); if ($u->abs($b,1) ne $expect && $uref !~ /^http:/) { $bad++; - print qq(URI->new("$uref")->abs(URI->new("$base"), 1)\n); + diag qq(URI->new("$uref")->abs(URI->new("$base"), 1)); } # Let's try the other way @@ -42,13 +41,12 @@ while (<DATA>) { push(@rel_fail, qq($testno: URI->new("$expect", "$base")->rel ==> "$u" (not "$uref")\n)); } - print "not " if $bad; - print "ok ", $testno++, "\n"; + ok !$bad, "$uref => $expect"; } if (@rel_fail) { - print "\n\nIn the following cases we did not get back to where we started with rel()\n"; - print @rel_fail; + note "\n\nIn the following cases we did not get back to where we started with rel()"; + note @rel_fail; } @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..2\n"; +use Test::More tests => 2; use URI::URL (); @@ -14,8 +14,6 @@ $u1->base("http://yyy/"); #use Data::Dump; Data::Dump::dump($b, $u1, $u2); -print "not " unless $u1->abs->as_string eq "http://yyy/foo"; -print "ok 1\n"; +is $u1->abs->as_string, "http://yyy/foo"; -print "not " unless $u2->abs->as_string eq "http://www/foo"; -print "ok 2\n"; +is $u2->abs->as_string, "http://www/foo"; @@ -1,102 +1,80 @@ use strict; use warnings; -print "1..22\n"; +use Test::More tests => 22; use URI (); my $u = URI->new("data:,A%20brief%20note"); -print "not " unless $u->scheme eq "data" && $u->opaque eq ",A%20brief%20note"; -print "ok 1\n"; +ok($u->scheme eq "data" && $u->opaque eq ",A%20brief%20note"); -print "not " unless $u->media_type eq "text/plain;charset=US-ASCII" && - $u->data eq "A brief note"; -print "ok 2\n"; +ok($u->media_type eq "text/plain;charset=US-ASCII" && + $u->data eq "A brief note"); my $old = $u->data("Får-i-kål er tingen!"); -print "not " unless $old eq "A brief note" && $u eq "data:,F%E5r-i-k%E5l%20er%20tingen!"; -print "ok 3\n"; +ok($old eq "A brief note" && $u eq "data:,F%E5r-i-k%E5l%20er%20tingen!"); $old = $u->media_type("text/plain;charset=iso-8859-1"); -print "not " unless $old eq "text/plain;charset=US-ASCII" && - $u eq "data:text/plain;charset=iso-8859-1,F%E5r-i-k%E5l%20er%20tingen!"; -print "ok 4\n"; +ok($old eq "text/plain;charset=US-ASCII" && + $u eq "data:text/plain;charset=iso-8859-1,F%E5r-i-k%E5l%20er%20tingen!"); $u = URI->new("data:image/gif;base64,R0lGODdhMAAwAPAAAAAAAP///ywAAAAAMAAwAAAC8IyPqcvt3wCcDkiLc7C0qwyGHhSWpjQu5yqmCYsapyuvUUlvONmOZtfzgFzByTB10QgxOR0TqBQejhRNzOfkVJ+5YiUqrXF5Y5lKh/DeuNcP5yLWGsEbtLiOSpa/TPg7JpJHxyendzWTBfX0cxOnKPjgBzi4diinWGdkF8kjdfnycQZXZeYGejmJlZeGl9i2icVqaNVailT6F5iJ90m6mvuTS4OK05M0vDk0Q4XUtwvKOzrcd3iq9uisF81M1OIcR7lEewwcLp7tuNNkM3uNna3F2JQFo97Vriy/Xl4/f1cf5VWzXyym7PHhhx4dbgYKAAA7"); -print "not " unless $u->media_type eq "image/gif"; -print "ok 5\n"; +is($u->media_type, "image/gif"); if ($ENV{DISPLAY} && $ENV{XV}) { open(XV, "| $ENV{XV} -") || die; print XV $u->data; close(XV); } -print "not " unless length($u->data) == 273; -print "ok 6\n"; +is(length($u->data), 273); $u = URI->new("data:text/plain;charset=iso-8859-7,%be%fg%be"); # %fg -print "not " unless $u->data eq "\xBE%fg\xBE"; -print "ok 7\n"; +is($u->data, "\xBE%fg\xBE"); $u = URI->new("data:application/vnd-xxx-query,select_vcount,fcol_from_fieldtable/local"); -print "not " unless $u->data eq "select_vcount,fcol_from_fieldtable/local"; -print "ok 8\n"; +is($u->data, "select_vcount,fcol_from_fieldtable/local"); $u->data(""); -print "not " unless $u eq "data:application/vnd-xxx-query,"; -print "ok 9\n"; +is($u, "data:application/vnd-xxx-query,"); $u->data("a,b"); $u->media_type(undef); -print "not " unless $u eq "data:,a,b"; -print "ok 10\n"; +is($u, "data:,a,b"); # Test automatic selection of URI/BASE64 encoding $u = URI->new("data:"); $u->data(""); -print "not " unless $u eq "data:,"; -print "ok 11\n"; +is($u, "data:,"); $u->data(">"); -print "not " unless $u eq "data:,%3E" && $u->data eq ">"; -print "ok 12\n"; +ok($u eq "data:,%3E" && $u->data eq ">"); $u->data(">>>>>"); -print "not " unless $u eq "data:,%3E%3E%3E%3E%3E"; -print "ok 13\n"; +is($u, "data:,%3E%3E%3E%3E%3E"); $u->data(">>>>>>"); -print "not " unless $u eq "data:;base64,Pj4+Pj4+"; -print "ok 14\n"; +is($u, "data:;base64,Pj4+Pj4+"); $u->media_type("text/plain;foo=bar"); -print "not " unless $u eq "data:text/plain;foo=bar;base64,Pj4+Pj4+"; -print "ok 15\n"; +is($u, "data:text/plain;foo=bar;base64,Pj4+Pj4+"); $u->media_type("foo"); -print "not " unless $u eq "data:foo;base64,Pj4+Pj4+"; -print "ok 16\n"; +is($u, "data:foo;base64,Pj4+Pj4+"); $u->data(">" x 3000); -print "not " unless $u eq ("data:foo;base64," . ("Pj4+" x 1000)) && - $u->data eq (">" x 3000); -print "ok 17\n"; +ok($u eq ("data:foo;base64," . ("Pj4+" x 1000)) && + $u->data eq (">" x 3000)); $u->media_type(undef); $u->data(undef); -print "not " unless $u eq "data:,"; -print "ok 18\n"; +is($u, "data:,"); $u = URI->new("data:foo"); -print "not " unless $u->media_type("bar,båz") eq "foo"; -print "ok 19\n"; +is($u->media_type("bar,båz"), "foo"); -print "not " unless $u->media_type eq "bar,båz"; -print "ok 20\n"; +is($u->media_type, "bar,båz"); $old = $u->data("new"); -print "not " unless $old eq "" && $u eq "data:bar%2Cb%E5z,new"; -print "ok 21\n"; +ok($old eq "" && $u eq "data:bar%2Cb%E5z,new"); -print "not " unless URI->new('data:;base64,%51%6D%70%76%5A%58%4A%75')->data eq "Bjoern"; -print "ok 22\n"; +is(URI->new('data:;base64,%51%6D%70%76%5A%58%4A%75')->data, "Bjoern"); @@ -1,53 +1,40 @@ use strict; use warnings; -print "1..13\n"; +use Test::More tests => 13; use URI (); my $uri; $uri = URI->new("ftp://ftp.example.com/path"); -print "not " unless $uri->scheme eq "ftp"; -print "ok 1\n"; +is($uri->scheme, "ftp"); -print "not " unless $uri->host eq "ftp.example.com"; -print "ok 2\n"; +is($uri->host, "ftp.example.com"); -print "not " unless $uri->port eq 21; -print "ok 3\n"; +is($uri->port, 21); -print "not " unless $uri->user eq "anonymous"; -print "ok 4\n"; +is($uri->user, "anonymous"); -print "not " unless $uri->password eq 'anonymous@'; -print "ok 5\n"; +is($uri->password, 'anonymous@'); $uri->userinfo("gisle\@aas.no"); -print "not " unless $uri eq "ftp://gisle%40aas.no\@ftp.example.com/path"; -print "ok 6\n"; +is($uri, "ftp://gisle%40aas.no\@ftp.example.com/path"); -print "not " unless $uri->user eq "gisle\@aas.no"; -print "ok 7\n"; +is($uri->user, "gisle\@aas.no"); -print "not " if defined($uri->password); -print "ok 8\n"; +is($uri->password, undef); $uri->password("secret"); -print "not " unless $uri eq "ftp://gisle%40aas.no:secret\@ftp.example.com/path"; -print "ok 9\n"; +is($uri, "ftp://gisle%40aas.no:secret\@ftp.example.com/path"); $uri = URI->new("ftp://gisle\@aas.no:secret\@ftp.example.com/path"); -print "not " unless $uri eq "ftp://gisle\@aas.no:secret\@ftp.example.com/path"; -print "ok 10\n"; +is($uri, "ftp://gisle\@aas.no:secret\@ftp.example.com/path"); -print "not " unless $uri->userinfo eq "gisle\@aas.no:secret"; -print "ok 11\n"; +is($uri->userinfo, "gisle\@aas.no:secret"); -print "not " unless $uri->user eq "gisle\@aas.no"; -print "ok 12\n"; +is($uri->user, "gisle\@aas.no"); -print "not " unless $uri->password eq "secret"; -print "ok 13\n"; +is($uri->password, "secret"); diff --git a/t/generic.t b/t/generic.t index 4885ced..31cfd03 100644 --- a/t/generic.t +++ b/t/generic.t @@ -1,219 +1,171 @@ use strict; use warnings; -print "1..48\n"; +use Test::More tests => 48; use URI (); my $foo = URI->new("Foo:opaque#frag"); -print "not " unless ref($foo) eq "URI::_foreign"; -print "ok 1\n"; +is(ref($foo), "URI::_foreign"); -print "not " unless $foo->as_string eq "Foo:opaque#frag"; -print "ok 2\n"; +is($foo->as_string, "Foo:opaque#frag"); -print "not " unless "$foo" eq "Foo:opaque#frag"; -print "ok 3\n"; +is("$foo", "Foo:opaque#frag"); # Try accessors -print "not " unless $foo->_scheme eq "Foo" && $foo->scheme eq "foo" && !$foo->has_recognized_scheme; -print "ok 4\n"; +ok($foo->_scheme eq "Foo" && $foo->scheme eq "foo" && !$foo->has_recognized_scheme); -print "not " unless $foo->opaque eq "opaque"; -print "ok 5\n"; +is($foo->opaque, "opaque"); -print "not " unless $foo->fragment eq "frag"; -print "ok 6\n"; +is($foo->fragment, "frag"); -print "not " unless $foo->canonical eq "foo:opaque#frag"; -print "ok 7\n"; +is($foo->canonical, "foo:opaque#frag"); # Try modificators my $old = $foo->scheme("bar"); -print "not " unless $old eq "foo" && $foo eq "bar:opaque#frag"; -print "ok 8\n"; +ok($old eq "foo" && $foo eq "bar:opaque#frag"); $old = $foo->scheme(""); -print "not " unless $old eq "bar" && $foo eq "opaque#frag"; -print "ok 9\n"; +ok($old eq "bar" && $foo eq "opaque#frag"); $old = $foo->scheme("foo"); $old = $foo->scheme(undef); -print "not " unless $old eq "foo" && $foo eq "opaque#frag"; -print "ok 10\n"; +ok($old eq "foo" && $foo eq "opaque#frag"); $foo->scheme("foo"); $old = $foo->opaque("xxx"); -print "not " unless $old eq "opaque" && $foo eq "foo:xxx#frag"; -print "ok 11\n"; +ok($old eq "opaque" && $foo eq "foo:xxx#frag"); $old = $foo->opaque(""); -print "not " unless $old eq "xxx" && $foo eq "foo:#frag"; -print "ok 12\n"; +ok($old eq "xxx" && $foo eq "foo:#frag"); $old = $foo->opaque(" #?/"); $old = $foo->opaque(undef); -print "not " unless $old eq "%20%23?/" && $foo eq "foo:#frag"; -print "ok 13\n"; +ok($old eq "%20%23?/" && $foo eq "foo:#frag"); $foo->opaque("opaque"); $old = $foo->fragment("x"); -print "not " unless $old eq "frag" && $foo eq "foo:opaque#x"; -print "ok 14\n"; +ok($old eq "frag" && $foo eq "foo:opaque#x"); $old = $foo->fragment(""); -print "not " unless $old eq "x" && $foo eq "foo:opaque#"; -print "ok 15\n"; +ok($old eq "x" && $foo eq "foo:opaque#"); $old = $foo->fragment(undef); -print "not " unless $old eq "" && $foo eq "foo:opaque"; -print "ok 16\n"; +ok($old eq "" && $foo eq "foo:opaque"); # Compare -print "not " unless $foo->eq("Foo:opaque") && - $foo->eq(URI->new("FOO:opaque")) && - $foo->eq("foo:opaque"); -print "ok 17\n"; +ok($foo->eq("Foo:opaque") && + $foo->eq(URI->new("FOO:opaque")) && + $foo->eq("foo:opaque")); -print "not " if $foo->eq("Bar:opaque") || - $foo->eq("foo:opaque#"); -print "ok 18\n"; +ok(!$foo->eq("Bar:opaque") && + !$foo->eq("foo:opaque#")); # Try hierarchal unknown URLs $foo = URI->new("foo://host:80/path?query#frag"); -print "not " unless "$foo" eq "foo://host:80/path?query#frag"; -print "ok 19\n"; +is("$foo", "foo://host:80/path?query#frag"); # Accessors -print "not " unless $foo->scheme eq "foo"; -print "ok 20\n"; +is($foo->scheme, "foo"); -print "not " unless $foo->authority eq "host:80"; -print "ok 21\n"; +is($foo->authority, "host:80"); -print "not " unless $foo->path eq "/path"; -print "ok 22\n"; +is($foo->path, "/path"); -print "not " unless $foo->query eq "query"; -print "ok 23\n"; +is($foo->query, "query"); -print "not " unless $foo->fragment eq "frag"; -print "ok 24\n"; +is($foo->fragment, "frag"); # Modificators $old = $foo->authority("xxx"); -print "not " unless $old eq "host:80" && $foo eq "foo://xxx/path?query#frag"; -print "ok 25\n"; +ok($old eq "host:80" && $foo eq "foo://xxx/path?query#frag"); $old = $foo->authority(""); -print "not " unless $old eq "xxx" && $foo eq "foo:///path?query#frag"; -print "ok 26\n"; +ok($old eq "xxx" && $foo eq "foo:///path?query#frag"); $old = $foo->authority(undef); -print "not " unless $old eq "" && $foo eq "foo:/path?query#frag"; -print "ok 27\n"; +ok($old eq "" && $foo eq "foo:/path?query#frag"); $old = $foo->authority("/? #;@&"); -print "not " unless !defined($old) && $foo eq "foo://%2F%3F%20%23;@&/path?query#frag"; -print "ok 28\n"; +ok(!defined($old) && $foo eq "foo://%2F%3F%20%23;@&/path?query#frag"); $old = $foo->authority("host:80"); -print "not " unless $old eq "%2F%3F%20%23;@&" && $foo eq "foo://host:80/path?query#frag"; -print "ok 29\n"; +ok($old eq "%2F%3F%20%23;@&" && $foo eq "foo://host:80/path?query#frag"); $old = $foo->path("/foo"); -print "not " unless $old eq "/path" && $foo eq "foo://host:80/foo?query#frag"; -print "ok 30\n"; +ok($old eq "/path" && $foo eq "foo://host:80/foo?query#frag"); $old = $foo->path("bar"); -print "not " unless $old eq "/foo" && $foo eq "foo://host:80/bar?query#frag"; -print "ok 31\n"; +ok($old eq "/foo" && $foo eq "foo://host:80/bar?query#frag"); $old = $foo->path(""); -print "not " unless $old eq "/bar" && $foo eq "foo://host:80?query#frag"; -print "ok 32\n"; +ok($old eq "/bar" && $foo eq "foo://host:80?query#frag"); $old = $foo->path(undef); -print "not " unless $old eq "" && $foo eq "foo://host:80?query#frag"; -print "ok 33\n"; +ok($old eq "" && $foo eq "foo://host:80?query#frag"); $old = $foo->path("@;/?#"); -print "not " unless $old eq "" && $foo eq "foo://host:80/@;/%3F%23?query#frag"; -print "ok 34\n"; +ok($old eq "" && $foo eq "foo://host:80/@;/%3F%23?query#frag"); $old = $foo->path("path"); -print "not " unless $old eq "/@;/%3F%23" && $foo eq "foo://host:80/path?query#frag"; -print "ok 35\n"; +ok($old eq "/@;/%3F%23" && $foo eq "foo://host:80/path?query#frag"); $old = $foo->query("foo"); -print "not " unless $old eq "query" && $foo eq "foo://host:80/path?foo#frag"; -print "ok 36\n"; +ok($old eq "query" && $foo eq "foo://host:80/path?foo#frag"); $old = $foo->query(""); -print "not " unless $old eq "foo" && $foo eq "foo://host:80/path?#frag"; -print "ok 37\n"; +ok($old eq "foo" && $foo eq "foo://host:80/path?#frag"); $old = $foo->query(undef); -print "not " unless $old eq "" && $foo eq "foo://host:80/path#frag"; -print "ok 38\n"; +ok($old eq "" && $foo eq "foo://host:80/path#frag"); $old = $foo->query("/?&=# "); -print "not " unless !defined($old) && $foo eq "foo://host:80/path?/?&=%23%20#frag"; -print "ok 39\n"; +ok(!defined($old) && $foo eq "foo://host:80/path?/?&=%23%20#frag"); $old = $foo->query("query"); -print "not " unless $old eq "/?&=%23%20" && $foo eq "foo://host:80/path?query#frag"; -print "ok 40\n"; +ok($old eq "/?&=%23%20" && $foo eq "foo://host:80/path?query#frag"); # Some buildup trics $foo = URI->new(""); $foo->path("path"); $foo->authority("auth"); -print "not " unless $foo eq "//auth/path"; -print "ok 41\n"; +is($foo, "//auth/path"); $foo = URI->new("", "http:"); $foo->query("query"); $foo->authority("auth"); -print "not " unless $foo eq "//auth?query" && $foo->has_recognized_scheme; -print "ok 42\n"; +ok($foo eq "//auth?query" && $foo->has_recognized_scheme); $foo->path("path"); -print "not " unless $foo eq "//auth/path?query"; -print "ok 43\n"; +is($foo, "//auth/path?query"); $foo = URI->new(""); $old = $foo->path("foo"); -print "not " unless $old eq "" && $foo eq "foo" && !$foo->has_recognized_scheme; -print "ok 44\n"; +ok($old eq "" && $foo eq "foo" && !$foo->has_recognized_scheme); $old = $foo->path("bar"); -print "not " unless $old eq "foo" && $foo eq "bar"; -print "ok 45\n"; +ok($old eq "foo" && $foo eq "bar"); $old = $foo->opaque("foo"); -print "not " unless $old eq "bar" && $foo eq "foo"; -print "ok 46\n"; +ok($old eq "bar" && $foo eq "foo"); $old = $foo->path(""); -print "not " unless $old eq "foo" && $foo eq ""; -print "ok 47\n"; +ok($old eq "foo" && $foo eq ""); $old = $foo->query("q"); -print "not " unless !defined($old) && $foo eq "?q"; -print "ok 48\n"; +ok(!defined($old) && $foo eq "?q"); @@ -1,22 +1,10 @@ use strict; use warnings; -print "1..48\n"; +use Test::More tests => 48; use URI (); -my $t = 1; -sub is { - my ($exp, $got) = @_; - if (!defined $exp) { - print "not " if defined $got; - } - else { - print "not " unless $got eq $exp; - } - print "ok " . ($t++) . "\n"; -} - sub check_gopher_uri { my ($u, $exphost, $expport, $exptype, $expselector, $expsearch) = @_; is("gopher", $u->scheme); diff --git a/t/heuristic.t b/t/heuristic.t index e64c338..037497b 100644 --- a/t/heuristic.t +++ b/t/heuristic.t @@ -13,7 +13,7 @@ BEGIN { }; } -print "1..26\n"; +use Test::More tests => 26; use URI::Heuristic qw(uf_url uf_urlstr); if (shift) { @@ -21,33 +21,28 @@ if (shift) { open(STDERR, ">&STDOUT"); # redirect STDERR } -print "not " unless uf_urlstr("http://www.sn.no/") eq "http://www.sn.no/"; -print "ok 1\n"; +is(uf_urlstr("http://www.sn.no/"), "http://www.sn.no/"); if ($^O eq "MacOS") { - print "not " unless uf_urlstr("etc:passwd") eq "file:/etc/passwd"; + is(uf_urlstr("etc:passwd"), "file:/etc/passwd"); } else { -print "not " unless uf_urlstr("/etc/passwd") eq "file:/etc/passwd"; + is(uf_urlstr("/etc/passwd"), "file:/etc/passwd"); } -print "ok 2\n"; if ($^O eq "MacOS") { - print "not " unless uf_urlstr(":foo.txt") eq "file:./foo.txt"; + is(uf_urlstr(":foo.txt"), "file:./foo.txt"); } else { -print "not " unless uf_urlstr("./foo.txt") eq "file:./foo.txt"; + is(uf_urlstr("./foo.txt"), "file:./foo.txt"); } -print "ok 3\n"; -print "not " unless uf_urlstr("ftp.aas.no/lwp.tar.gz") eq "ftp://ftp.aas.no/lwp.tar.gz"; -print "ok 4\n"; +is(uf_urlstr("ftp.aas.no/lwp.tar.gz"), "ftp://ftp.aas.no/lwp.tar.gz"); if($^O eq "MacOS") { # its a weird, but valid, MacOS path, so it can't be left alone - print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:/C/%5CCONFIG.SYS"; + is(uf_urlstr("C:\\CONFIG.SYS"), "file:/C/%5CCONFIG.SYS"); } else { -print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:C:\\CONFIG.SYS"; + is(uf_urlstr("C:\\CONFIG.SYS"), "file:C:\\CONFIG.SYS"); } -print "ok 5\n"; { local $ENV{LC_ALL} = ""; @@ -56,83 +51,62 @@ print "ok 5\n"; $ENV{LC_ALL} = "en_GB.UTF-8"; undef $URI::Heuristic::MY_COUNTRY; - print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; - print "ok 6\n"; + like(uf_urlstr("perl/camel.gif"), qr,^http://www\.perl\.(org|co)\.uk/camel\.gif$,); use Net::Domain (); $ENV{LC_ALL} = "C"; { no warnings; *Net::Domain::hostfqdn = sub { return 'vasya.su' } } undef $URI::Heuristic::MY_COUNTRY; - print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.su/camel\.gif$,; - print "ok 7\n"; + is(uf_urlstr("perl/camel.gif"), "http://www.perl.su/camel.gif"); $ENV{LC_ALL} = "C"; { no warnings; *Net::Domain::hostfqdn = sub { return '' } } undef $URI::Heuristic::MY_COUNTRY; - print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,; - print "ok 8\n"; + like(uf_urlstr("perl/camel.gif"), qr,^http://www\.perl\.(com|org)/camel\.gif$,); $ENV{HTTP_ACCEPT_LANGUAGE} = "en-ca"; undef $URI::Heuristic::MY_COUNTRY; - print "not " unless uf_urlstr("perl/camel.gif") eq "http://www.perl.ca/camel.gif"; - print "ok 9\n"; + is(uf_urlstr("perl/camel.gif"), "http://www.perl.ca/camel.gif"); } $URI::Heuristic::MY_COUNTRY = "bv"; -print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,; -print "ok 10\n"; +like(uf_urlstr("perl/camel.gif"), qr,^http://www\.perl\.(com|org)/camel\.gif$,); # Backwards compatibility; uk != United Kingdom in ISO 3166 $URI::Heuristic::MY_COUNTRY = "uk"; -print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; -print "ok 11\n"; +like(uf_urlstr("perl/camel.gif"), qr,^http://www\.perl\.(org|co)\.uk/camel\.gif$,); $URI::Heuristic::MY_COUNTRY = "gb"; -print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; -print "ok 12\n"; +like(uf_urlstr("perl/camel.gif"), qr,^http://www\.perl\.(org|co)\.uk/camel\.gif$,); $ENV{URL_GUESS_PATTERN} = "www.ACME.org www.ACME.com"; -print "not " unless uf_urlstr("perl") eq "http://www.perl.org"; -print "ok 13\n"; +is(uf_urlstr("perl"), "http://www.perl.org"); { local $ENV{URL_GUESS_PATTERN} = ""; - print "not " unless uf_urlstr("perl") eq "http://perl"; - print "ok 14\n"; + is(uf_urlstr("perl"), "http://perl"); - print "not " unless uf_urlstr("http:80") eq "http:80"; - print "ok 15\n"; + is(uf_urlstr("http:80"), "http:80"); - print "not " unless uf_urlstr("mailto:gisle\@aas.no") eq "mailto:gisle\@aas.no"; - print "ok 16\n"; + is(uf_urlstr("mailto:gisle\@aas.no"), "mailto:gisle\@aas.no"); - print "not " unless uf_urlstr("gisle\@aas.no") eq "mailto:gisle\@aas.no"; - print "ok 17\n"; + is(uf_urlstr("gisle\@aas.no"), "mailto:gisle\@aas.no"); - print "not " unless uf_urlstr("Gisle.Aas\@aas.perl.org") eq "mailto:Gisle.Aas\@aas.perl.org"; - print "ok 18\n"; + is(uf_urlstr("Gisle.Aas\@aas.perl.org"), "mailto:Gisle.Aas\@aas.perl.org"); - print "not " unless uf_url("gopher.sn.no")->scheme eq "gopher"; - print "ok 19\n"; + is(uf_url("gopher.sn.no")->scheme, "gopher"); - print "not " unless uf_urlstr("123.3.3.3:8080/foo") eq "http://123.3.3.3:8080/foo"; - print "ok 20\n"; + is(uf_urlstr("123.3.3.3:8080/foo"), "http://123.3.3.3:8080/foo"); - print "not " unless uf_urlstr("123.3.3.3:443/foo") eq "https://123.3.3.3:443/foo"; - print "ok 21\n"; + is(uf_urlstr("123.3.3.3:443/foo"), "https://123.3.3.3:443/foo"); - print "not " unless uf_urlstr("123.3.3.3:21/foo") eq "ftp://123.3.3.3:21/foo"; - print "ok 22\n"; + is(uf_urlstr("123.3.3.3:21/foo"), "ftp://123.3.3.3:21/foo"); - print "not " unless uf_url("FTP.example.com")->scheme eq "ftp"; - print "ok 23\n"; + is(uf_url("FTP.example.com")->scheme, "ftp"); - print "not " unless uf_url("ftp2.example.com")->scheme eq "ftp"; - print "ok 24\n"; + is(uf_url("ftp2.example.com")->scheme, "ftp"); - print "not " unless uf_url("ftp")->scheme eq "ftp"; - print "ok 25\n"; + is(uf_url("ftp")->scheme, "ftp"); - print "not " unless uf_url("https.example.com")->scheme eq "https"; - print "ok 26\n"; + is(uf_url("https.example.com")->scheme, "https"); } @@ -1,66 +1,50 @@ use strict; use warnings; -print "1..16\n"; +use Test::More tests => 16; use URI (); my $u = URI->new("<http://www.example.com/path?q=fôo>"); #print "$u\n"; -print "not " unless $u eq "http://www.example.com/path?q=f%F4o"; -print "ok 1\n"; +is($u, "http://www.example.com/path?q=f%F4o"); -print "not " unless $u->port == 80; -print "ok 2\n"; +is($u->port, 80); # play with port my $old = $u->port(8080); -print "not " unless $old == 80 && $u eq "http://www.example.com:8080/path?q=f%F4o"; -print "ok 3\n"; +ok($old == 80 && $u eq "http://www.example.com:8080/path?q=f%F4o"); $u->port(80); -print "not " unless $u eq "http://www.example.com:80/path?q=f%F4o"; -print "ok 4\n"; +is($u, "http://www.example.com:80/path?q=f%F4o"); $u->port(""); -print "not " unless $u eq "http://www.example.com:/path?q=f%F4o" && $u->port == 80; -print "ok 5\n"; +ok($u eq "http://www.example.com:/path?q=f%F4o" && $u->port == 80); $u->port(undef); -print "not " unless $u eq "http://www.example.com/path?q=f%F4o"; -print "ok 6\n"; +is($u, "http://www.example.com/path?q=f%F4o"); my @q = $u->query_form; -print "not " unless @q == 2 && "@q" eq "q fôo"; -print "ok 7\n"; +is_deeply(\@q, ["q", "fôo"]); $u->query_form(foo => "bar", bar => "baz"); -print "not " unless $u->query eq "foo=bar&bar=baz"; -print "ok 8\n"; +is($u->query, "foo=bar&bar=baz"); -print "not " unless $u->host eq "www.example.com"; -print "ok 9\n"; +is($u->host, "www.example.com"); -print "not " unless $u->path eq "/path"; -print "ok 10\n"; +is($u->path, "/path"); -print "not " if $u->secure; -print "ok 11\n"; +ok(!$u->secure); $u->scheme("https"); -print "not " unless $u->port == 443; -print "ok 12\n"; +is($u->port, 443); -print "not " unless $u eq "https://www.example.com/path?foo=bar&bar=baz"; -print "ok 13\n"; +is($u, "https://www.example.com/path?foo=bar&bar=baz"); -print "not " unless $u->secure; -print "ok 14\n"; +ok($u->secure); $u = URI->new("http://%65%78%61%6d%70%6c%65%2e%63%6f%6d/%70%75%62/%61/%32%30%30%31/%30%38/%32%37/%62%6a%6f%72%6e%73%74%61%64%2e%68%74%6d%6c"); -print "not " unless $u->canonical eq "http://example.com/pub/a/2001/08/27/bjornstad.html"; -print "ok 15\n"; +is($u->canonical, "http://example.com/pub/a/2001/08/27/bjornstad.html"); -print "not " unless $u->has_recognized_scheme; -print "ok 16\n"; +ok($u->has_recognized_scheme); @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..24\n"; +use Test::More tests => 24; use URI (); @@ -9,111 +9,87 @@ my $uri; $uri = URI->new("ldap://host/dn=base?cn,sn?sub?objectClass=*"); -print "not " unless $uri->host eq "host"; -print "ok 1\n"; +is($uri->host, "host"); -print "not " unless $uri->dn eq "dn=base"; -print "ok 2\n"; +is($uri->dn, "dn=base"); -print "not " unless join("-",$uri->attributes) eq "cn-sn"; -print "ok 3\n"; +is(join("-",$uri->attributes), "cn-sn"); -print "not " unless $uri->scope eq "sub"; -print "ok 4\n"; +is($uri->scope, "sub"); -print "not " unless $uri->filter eq "objectClass=*"; -print "ok 5\n"; +is($uri->filter, "objectClass=*"); $uri = URI->new("ldap:"); $uri->dn("o=University of Michigan,c=US"); -print "not " unless "$uri" eq "ldap:o=University%20of%20Michigan,c=US" && - $uri->dn eq "o=University of Michigan,c=US"; -print "ok 6\n"; +ok("$uri" eq "ldap:o=University%20of%20Michigan,c=US" && + $uri->dn eq "o=University of Michigan,c=US"); $uri->host("ldap.itd.umich.edu"); -print "not " unless $uri->as_string eq "ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US"; -print "ok 7\n"; +is($uri->as_string, "ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US"); # check defaults -print "not " unless $uri->_scope eq "" && - $uri->scope eq "base" && - $uri->_filter eq "" && - $uri->filter eq "(objectClass=*)"; -print "ok 8\n"; +ok($uri->_scope eq "" && + $uri->scope eq "base" && + $uri->_filter eq "" && + $uri->filter eq "(objectClass=*)"); # attribute $uri->attributes("postalAddress"); -print "not " unless $uri eq "ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US?postalAddress"; -print "ok 9\n"; +is($uri, "ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US?postalAddress"); # does attribute escapeing work as it should $uri->attributes($uri->attributes, "foo", ",", "*", "?", "#", "\0"); -print "not " unless $uri->attributes eq "postalAddress,foo,%2C,*,%3F,%23,%00" && - join("-", $uri->attributes) eq "postalAddress-foo-,-*-?-#-\0"; -print "ok 10\n"; +ok($uri->attributes eq "postalAddress,foo,%2C,*,%3F,%23,%00" && + join("-", $uri->attributes) eq "postalAddress-foo-,-*-?-#-\0"); $uri->attributes(""); $uri->scope("sub?#"); -print "not " unless $uri->query eq "?sub%3F%23" && - $uri->scope eq "sub?#"; -print "ok 11\n"; +ok($uri->query eq "?sub%3F%23" && + $uri->scope eq "sub?#"); $uri->scope(""); $uri->filter("f=?,#"); -print "not " unless $uri->query eq "??f=%3F,%23" && - $uri->filter eq "f=?,#"; +ok($uri->query eq "??f=%3F,%23" && + $uri->filter eq "f=?,#"); $uri->filter("(int=\\00\\00\\00\\04)"); -print "not " unless $uri->query eq "??(int=%5C00%5C00%5C00%5C04)"; -print "ok 12\n"; +is($uri->query, "??(int=%5C00%5C00%5C00%5C04)"); -print "ok 13\n"; $uri->filter(""); $uri->extensions("!bindname" => "cn=Manager,co=Foo"); my %ext = $uri->extensions; -print "not " unless $uri->query eq "???!bindname=cn=Manager%2Cco=Foo" && - keys %ext == 1 && - $ext{"!bindname"} eq "cn=Manager,co=Foo"; -print "ok 14\n"; +ok($uri->query eq "???!bindname=cn=Manager%2Cco=Foo" && + keys %ext == 1 && + $ext{"!bindname"} eq "cn=Manager,co=Foo"); $uri = URI->new("ldap://LDAP-HOST:389/o=University%20of%20Michigan,c=US?postalAddress?base?ObjectClass=*?FOO=Bar,bindname=CN%3DManager%CO%3dFoo"); -print "not " unless $uri->canonical eq "ldap://ldap-host/o=University%20of%20Michigan,c=US?postaladdress???foo=Bar,bindname=CN=Manager%CO=Foo"; -print "ok 15\n"; +is($uri->canonical, "ldap://ldap-host/o=University%20of%20Michigan,c=US?postaladdress???foo=Bar,bindname=CN=Manager%CO=Foo"); -print "$uri\n"; -print $uri->canonical, "\n"; +note $uri; +note $uri->canonical; -print "not " if $uri->secure; -print "ok 16\n"; +ok(!$uri->secure); $uri = URI->new("ldaps://host/dn=base?cn,sn?sub?objectClass=*"); -print "not " unless $uri->host eq "host"; -print "ok 17\n"; -print "not " unless $uri->port eq 636; -print "ok 18\n"; -print "not " unless $uri->dn eq "dn=base"; -print "ok 19\n"; -print "not " unless $uri->secure; -print "ok 20\n"; +is($uri->host, "host"); +is($uri->port, 636); +is($uri->dn, "dn=base"); +ok($uri->secure); $uri = URI->new("ldapi://%2Ftmp%2Fldap.sock/????x-mod=-w--w----"); -print "not " unless $uri->authority eq "%2Ftmp%2Fldap.sock"; -print "ok 21\n"; -print "not " unless $uri->un_path eq "/tmp/ldap.sock"; -print "ok 22\n"; +is($uri->authority, "%2Ftmp%2Fldap.sock"); +is($uri->un_path, "/tmp/ldap.sock"); $uri->un_path("/var/x\@foo:bar/"); -print "not " unless $uri eq "ldapi://%2Fvar%2Fx%40foo%3Abar%2F/????x-mod=-w--w----"; -print "ok 23\n"; +is($uri, "ldapi://%2Fvar%2Fx%40foo%3Abar%2F/????x-mod=-w--w----"); %ext = $uri->extensions; -print "not " unless $ext{"x-mod"} eq "-w--w----"; -print "ok 24\n"; +is($ext{"x-mod"}, "-w--w----"); @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..6\n"; +use Test::More tests => 6; # Test mixing of URI and URI::WithBase objects use URI (); @@ -27,32 +27,28 @@ sub Dump } #Dump(); -print "not " unless $a->isa("URI") && - ref($b) eq ref($uw) && - ref($c) eq ref($uu) && - $d->isa("URI"); -print "ok 1\n"; +ok($a->isa("URI") && + ref($b) eq ref($uw) && + ref($c) eq ref($uu) && + $d->isa("URI")); -print "not " if $b->base && $c->base; -print "ok 2\n"; +ok(not $b->base && $c->base); $a = URI::URL->new($rel, $u); $b = URI::URL->new($rel, $uw); $c = URI::URL->new($rel, $uu); $d = URI::URL->new($rel, $str); -print "not " unless ref($a) eq "URI::URL" && - ref($b) eq "URI::URL" && - ref($c) eq "URI::URL" && - ref($d) eq "URI::URL"; -print "ok 3\n"; +ok(ref($a) eq "URI::URL" && + ref($b) eq "URI::URL" && + ref($c) eq "URI::URL" && + ref($d) eq "URI::URL"); -print "not " unless ref($b->base) eq ref($uw) && - $b->base eq $uw && - ref($c->base) eq ref($uu) && - $c->base eq $uu && - $d->base eq $str; -print "ok 4\n"; +ok(ref($b->base) eq ref($uw) && + $b->base eq $uw && + ref($c->base) eq ref($uu) && + $c->base eq $uu && + $d->base eq $str); @@ -62,19 +58,17 @@ $c = URI->new($uu, $uu); $d = URI->new($uu, $str); #Dump(); -print "not " unless ref($a) eq ref($b) && - ref($b) eq ref($c) && - ref($c) eq ref($d) && - ref($d) eq ref($u); -print "ok 5\n"; +ok(ref($a) eq ref($b) && + ref($b) eq ref($c) && + ref($c) eq ref($d) && + ref($d) eq ref($u)); $a = URI::URL->new($u, $u); $b = URI::URL->new($u, $uw); $c = URI::URL->new($u, $uu); $d = URI::URL->new($u, $str); -print "not " unless ref($a) eq "URI::URL" && - ref($b) eq "URI::URL" && - ref($c) eq "URI::URL" && - ref($d) eq "URI::URL"; -print "ok 6\n"; +ok(ref($a) eq "URI::URL" && + ref($b) eq "URI::URL" && + ref($c) eq "URI::URL" && + ref($d) eq "URI::URL"); @@ -1,38 +1,30 @@ use strict; use warnings; -print "1..8\n"; +use Test::More tests => 8; use URI (); my $u = URI->new("<mms://66.250.188.13/KFOG_FM>"); #print "$u\n"; -print "not " unless $u eq "mms://66.250.188.13/KFOG_FM"; -print "ok 1\n"; +is($u, "mms://66.250.188.13/KFOG_FM"); -print "not " unless $u->port == 1755; -print "ok 2\n"; +is($u->port, 1755); # play with port my $old = $u->port(8755); -print "not " unless $old == 1755 && $u eq "mms://66.250.188.13:8755/KFOG_FM"; -print "ok 3\n"; +ok($old == 1755 && $u eq "mms://66.250.188.13:8755/KFOG_FM"); $u->port(1755); -print "not " unless $u eq "mms://66.250.188.13:1755/KFOG_FM"; -print "ok 4\n"; +is($u, "mms://66.250.188.13:1755/KFOG_FM"); $u->port(""); -print "not " unless $u eq "mms://66.250.188.13:/KFOG_FM" && $u->port == 1755; -print "ok 5\n"; +ok($u eq "mms://66.250.188.13:/KFOG_FM" && $u->port == 1755); $u->port(undef); -print "not " unless $u eq "mms://66.250.188.13/KFOG_FM"; -print "ok 6\n"; +is($u, "mms://66.250.188.13/KFOG_FM"); -print "not " unless $u->host eq "66.250.188.13"; -print "ok 7\n"; +is($u->host, "66.250.188.13"); -print "not " unless $u->path eq "/KFOG_FM"; -print "ok 8\n"; +is($u->path, "/KFOG_FM"); @@ -1,57 +1,48 @@ use strict; use warnings; -print "1..8\n"; +use Test::More tests => 8; use URI (); my $u = URI->new("news:comp.lang.perl.misc"); -print "not " unless $u->group eq "comp.lang.perl.misc" && - !defined($u->message) && - $u->port == 119 && - $u eq "news:comp.lang.perl.misc"; -print "ok 1\n"; +ok($u->group eq "comp.lang.perl.misc" && + !defined($u->message) && + $u->port == 119 && + $u eq "news:comp.lang.perl.misc"); $u->host("news.online.no"); -print "not " unless $u->group eq "comp.lang.perl.misc" && - $u->port == 119 && - $u eq "news://news.online.no/comp.lang.perl.misc"; -print "ok 2\n"; +ok($u->group eq "comp.lang.perl.misc" && + $u->port == 119 && + $u eq "news://news.online.no/comp.lang.perl.misc"); $u->group("no.perl", 1 => 10); -print "not " unless $u eq "news://news.online.no/no.perl/1-10"; -print "ok 3\n"; +is($u, "news://news.online.no/no.perl/1-10"); my @g = $u->group; -#print "G: @g\n"; -print "not " unless @g == 3 && "@g" eq "no.perl 1 10"; -print "ok 4\n"; +is_deeply(\@g, ["no.perl", 1, 10]); $u->message('42@g.aas.no'); #print "$u\n"; -print "not " unless $u->message eq '42@g.aas.no' && - !defined($u->group) && - $u eq 'news://news.online.no/42@g.aas.no'; -print "ok 5\n"; +ok($u->message eq '42@g.aas.no' && + !defined($u->group) && + $u eq 'news://news.online.no/42@g.aas.no'); $u = URI->new("nntp:no.perl"); -print "not " unless $u->group eq "no.perl" && - $u->port == 119; -print "ok 6\n"; +ok($u->group eq "no.perl" && + $u->port == 119); $u = URI->new("snews://snews.online.no/no.perl"); -print "not " unless $u->group eq "no.perl" && - $u->host eq "snews.online.no" && - $u->port == 563; -print "ok 7\n"; +ok($u->group eq "no.perl" && + $u->host eq "snews.online.no" && + $u->port == 563); $u = URI->new("nntps://nntps.online.no/no.perl"); -print "not " unless $u->group eq "no.perl" && - $u->host eq "nntps.online.no" && - $u->port == 563; -print "ok 8\n"; +ok($u->group eq "no.perl" && + $u->host eq "nntps.online.no" && + $u->port == 563); diff --git a/t/old-absconf.t b/t/old-absconf.t index 536f4d7..5be6a02 100644 --- a/t/old-absconf.t +++ b/t/old-absconf.t @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..6\n"; +use Test::More tests => 6; use URI::URL qw(url); @@ -12,27 +12,21 @@ $URI::URL::ABS_ALLOW_RELATIVE_SCHEME = 1; my $u1 = url("../../../../abc", "http://web/a/b"); -print "not " unless $u1->abs->as_string eq "http://web/abc"; -print "ok 1\n"; +is($u1->abs->as_string, "http://web/abc"); { local $URI::URL::ABS_REMOTE_LEADING_DOTS; - print "not " unless $u1->abs->as_string eq "http://web/../../../abc"; - print "ok 2\n"; + is($u1->abs->as_string, "http://web/../../../abc"); } $u1 = url("http:../../../../abc", "http://web/a/b"); -print "not " unless $u1->abs->as_string eq "http://web/abc"; -print "ok 3\n"; +is($u1->abs->as_string, "http://web/abc"); { local $URI::URL::ABS_ALLOW_RELATIVE_SCHEME; - print "not " unless $u1->abs->as_string eq "http:../../../../abc"; - print "ok 4\n"; - print "not " unless $u1->abs(undef,1)->as_string eq "http://web/abc"; - print "ok 5\n"; + is($u1->abs->as_string, "http:../../../../abc"); + is($u1->abs(undef,1)->as_string, "http://web/abc"); } -print "not " unless $u1->abs(undef,0)->as_string eq "http:../../../../abc"; -print "ok 6\n"; +is($u1->abs(undef,0)->as_string, "http:../../../../abc"); diff --git a/t/old-file.t b/t/old-file.t index e1ab8f5..30bb45a 100644 --- a/t/old-file.t +++ b/t/old-file.t @@ -1,6 +1,8 @@ use strict; use warnings; +use Test::More; + use URI::file; $URI::file::DEFAULT_AUTHORITY = undef; @@ -43,10 +45,7 @@ my @extratests = ( my @os = @{shift @tests}; shift @os; # file -my $num = @tests; -print "1..$num\n"; - -my $testno = 1; +plan tests => scalar @tests; for my $t (@tests) { my @t = @$t; @@ -63,19 +62,17 @@ for my $t (@tests) { my $loose; $loose++ if $expect =~ s/^!//; if ($expect ne $f) { - print "URI->new('$file', 'file')->file('$os') ne $expect, but $f\n"; + diag "URI->new('$file', 'file')->file('$os') ne $expect, but $f"; $err++; } if (defined($t[$i]) && !$loose) { my $u2 = URI::file->new($t[$i], $os); unless ($u2->as_string eq $file) { - print "URI::file->new('$t[$i]', '$os') ne $file, but $u2\n"; + diag "URI::file->new('$t[$i]', '$os') ne $file, but $u2"; $err++; } } $i++; } - print "not " if $err; - print "ok $testno\n"; - $testno++; + ok !$err; } diff --git a/t/old-relbase.t b/t/old-relbase.t index ae76a1d..c679880 100644 --- a/t/old-relbase.t +++ b/t/old-relbase.t @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..5\n"; +use Test::More tests => 5; use URI::URL qw(url); @@ -16,22 +16,14 @@ my $a1 = $u1->abs->as_string; my $a2 = $u2->abs->as_string; my $a3 = $u3->abs->as_string; -print "$a1\n$a2\n$a3\n"; - -print "not " unless $a1 eq "http://www.acme.com/foo/bar"; -print "ok 1\n"; -print "not " unless $a2 eq "http://www.acme.com/foo/"; -print "ok 2\n"; -print "not " unless $a3 eq "http://www.acme.com/foo/zoo/foo"; -print "ok 3\n"; +is($a1, "http://www.acme.com/foo/bar"); +is($a2, "http://www.acme.com/foo/"); +is($a3, "http://www.acme.com/foo/zoo/foo"); # We used to have problems with URI::URL as the base class :-( my $u4 = url("foo", "URI::URL"); my $a4 = $u4->abs; -print "$a4\n"; -print "not " unless $u4 eq "foo" && $a4 eq "uri:/foo"; -print "ok 4\n"; +ok($u4 eq "foo" && $a4 eq "uri:/foo"); # Test new_abs for URI::URL objects -print "not " unless URI::URL->new_abs("foo", "http://foo/bar") eq "http://foo/foo"; -print "ok 5\n"; +is(URI::URL->new_abs("foo", "http://foo/bar"), "http://foo/foo"); @@ -1,50 +1,42 @@ use strict; use warnings; -print "1..8\n"; +use Test::More tests => 8; use URI (); my $u = URI->new('pop://aas@pop.sn.no'); -print "not " unless $u->user eq "aas" && - !defined($u->auth) && - $u->host eq "pop.sn.no" && - $u->port == 110 && - $u eq 'pop://aas@pop.sn.no'; -print "ok 1\n"; +ok($u->user eq "aas" && + !defined($u->auth) && + $u->host eq "pop.sn.no" && + $u->port == 110 && + $u eq 'pop://aas@pop.sn.no'); $u->auth("+APOP"); -print "not " unless $u->auth eq "+APOP" && - $u eq 'pop://aas;AUTH=+APOP@pop.sn.no'; -print "ok 2\n"; +ok($u->auth eq "+APOP" && + $u eq 'pop://aas;AUTH=+APOP@pop.sn.no'); $u->user("gisle"); -print "not " unless $u->user eq "gisle" && - $u eq 'pop://gisle;AUTH=+APOP@pop.sn.no'; -print "ok 3\n"; +ok($u->user eq "gisle" && + $u eq 'pop://gisle;AUTH=+APOP@pop.sn.no'); $u->port(4000); -print "not " unless $u eq 'pop://gisle;AUTH=+APOP@pop.sn.no:4000'; -print "ok 4\n"; +is($u, 'pop://gisle;AUTH=+APOP@pop.sn.no:4000'); $u = URI->new("pop:"); $u->host("pop.sn.no"); $u->user("aas"); $u->auth("*"); -print "not " unless $u eq 'pop://aas;AUTH=*@pop.sn.no'; -print "ok 5\n"; +is($u, 'pop://aas;AUTH=*@pop.sn.no'); $u->auth(undef); -print "not " unless $u eq 'pop://aas@pop.sn.no'; -print "ok 6\n"; +is($u, 'pop://aas@pop.sn.no'); $u->user(undef); -print "not " unless $u eq 'pop://pop.sn.no'; -print "ok 7\n"; +is($u, 'pop://pop.sn.no'); # Try some funny characters too $u->user('får;k@l'); -print "not " unless $u->user eq 'får;k@l' && - $u eq 'pop://f%E5r%3Bk%40l@pop.sn.no'; -print "ok 8\n"; +ok($u->user eq 'får;k@l' && + $u eq 'pop://f%E5r%3Bk%40l@pop.sn.no'); @@ -1,23 +1,19 @@ use strict; use warnings; -print "1..4\n"; +use Test::More tests => 4; use URI (); my $u = URI->new('rsync://gisle@example.com/foo/bar'); -print "not " unless $u->user eq "gisle"; -print "ok 1\n"; +is($u->user, "gisle"); -print "not " unless $u->port eq 873; -print "ok 2\n"; +is($u->port, 873); -print "not " unless $u->path eq "/foo/bar"; -print "ok 3\n"; +is($u->path, "/foo/bar"); $u->port(8730); -print "not " unless $u eq 'rsync://gisle@example.com:8730/foo/bar'; -print "ok 4\n"; +is($u, 'rsync://gisle@example.com:8730/foo/bar'); @@ -1,43 +1,34 @@ use strict; use warnings; -print "1..9\n"; +use Test::More tests => 9; use URI (); my $u = URI->new("<rtsp://media.example.com/fôo.smi/>"); #print "$u\n"; -print "not " unless $u eq "rtsp://media.example.com/f%F4o.smi/"; -print "ok 1\n"; +is($u, "rtsp://media.example.com/f%F4o.smi/"); -print "not " unless $u->port == 554; -print "ok 2\n"; +is($u->port, 554); # play with port my $old = $u->port(8554); -print "not " unless $old == 554 && $u eq "rtsp://media.example.com:8554/f%F4o.smi/"; -print "ok 3\n"; +ok($old == 554 && $u eq "rtsp://media.example.com:8554/f%F4o.smi/"); $u->port(554); -print "not " unless $u eq "rtsp://media.example.com:554/f%F4o.smi/"; -print "ok 4\n"; +is($u, "rtsp://media.example.com:554/f%F4o.smi/"); $u->port(""); -print "not " unless $u eq "rtsp://media.example.com:/f%F4o.smi/" && $u->port == 554; -print "ok 5\n"; +ok($u eq "rtsp://media.example.com:/f%F4o.smi/" && $u->port == 554); $u->port(undef); -print "not " unless $u eq "rtsp://media.example.com/f%F4o.smi/"; -print "ok 6\n"; +is($u, "rtsp://media.example.com/f%F4o.smi/"); -print "not " unless $u->host eq "media.example.com"; -print "ok 7\n"; +is($u->host, "media.example.com"); -print "not " unless $u->path eq "/f%F4o.smi/"; -print "ok 8\n"; +is($u->path, "/f%F4o.smi/"); $u->scheme("rtspu"); -print "not " unless $u->scheme eq "rtspu"; -print "ok 9\n"; +is($u->scheme, "rtspu"); @@ -1,69 +1,57 @@ use strict; use warnings; -print "1..11\n"; +use Test::More tests => 11; use URI (); my $u = URI->new('sip:phone@domain.ext'); -print "not " unless $u->user eq 'phone' && - $u->host eq 'domain.ext' && - $u->port eq '5060' && - $u eq 'sip:phone@domain.ext'; -print "ok 1\n"; +ok($u->user eq 'phone' && + $u->host eq 'domain.ext' && + $u->port eq '5060' && + $u eq 'sip:phone@domain.ext'); $u->host_port('otherdomain.int:9999'); -print "not " unless $u->host eq 'otherdomain.int' && - $u->port eq '9999' && - $u eq 'sip:phone@otherdomain.int:9999'; -print "ok 2\n"; +ok($u->host eq 'otherdomain.int' && + $u->port eq '9999' && + $u eq 'sip:phone@otherdomain.int:9999'); $u->port('5060'); $u = $u->canonical; -print "not " unless $u->host eq 'otherdomain.int' && - $u->port eq '5060' && - $u eq 'sip:phone@otherdomain.int'; -print "ok 3\n"; +ok($u->host eq 'otherdomain.int' && + $u->port eq '5060' && + $u eq 'sip:phone@otherdomain.int'); $u->user('voicemail'); -print "not " unless $u->user eq 'voicemail' && - $u eq 'sip:voicemail@otherdomain.int'; -print "ok 4\n"; +ok($u->user eq 'voicemail' && + $u eq 'sip:voicemail@otherdomain.int'); $u = URI->new('sip:phone@domain.ext?Subject=Meeting&Priority=Urgent'); -print "not " unless $u->host eq 'domain.ext' && - $u->query eq 'Subject=Meeting&Priority=Urgent'; -print "ok 5\n"; +ok($u->host eq 'domain.ext' && + $u->query eq 'Subject=Meeting&Priority=Urgent'); $u->query_form(Subject => 'Lunch', Priority => 'Low'); my @q = $u->query_form; -print "not " unless $u->host eq 'domain.ext' && - $u->query eq 'Subject=Lunch&Priority=Low' && - @q == 4 && "@q" eq "Subject Lunch Priority Low"; -print "ok 6\n"; +ok($u->host eq 'domain.ext' && + $u->query eq 'Subject=Lunch&Priority=Low' && + @q == 4 && "@q" eq "Subject Lunch Priority Low"); $u = URI->new('sip:phone@domain.ext;maddr=127.0.0.1;ttl=16'); -print "not " unless $u->host eq 'domain.ext' && - $u->params eq 'maddr=127.0.0.1;ttl=16'; -print "ok 7\n"; +ok($u->host eq 'domain.ext' && + $u->params eq 'maddr=127.0.0.1;ttl=16'); $u = URI->new('sip:phone@domain.ext?Subject=Meeting&Priority=Urgent'); $u->params_form(maddr => '127.0.0.1', ttl => '16'); my @p = $u->params_form; -print "not " unless $u->host eq 'domain.ext' && - $u->query eq 'Subject=Meeting&Priority=Urgent' && - $u->params eq 'maddr=127.0.0.1;ttl=16' && - @p == 4 && "@p" eq "maddr 127.0.0.1 ttl 16"; - -print "ok 8\n"; +ok($u->host eq 'domain.ext' && + $u->query eq 'Subject=Meeting&Priority=Urgent' && + $u->params eq 'maddr=127.0.0.1;ttl=16' && + @p == 4 && "@p" eq "maddr 127.0.0.1 ttl 16"); $u = URI->new_abs('sip:phone@domain.ext', 'sip:foo@domain2.ext'); -print "not " unless $u eq 'sip:phone@domain.ext'; -print "ok 9\n"; +is($u, 'sip:phone@domain.ext'); $u = URI->new('sip:phone@domain.ext'); -print "not " unless $u eq $u->abs('http://www.cpan.org/'); -print "ok 10\n"; +is($u, $u->abs('http://www.cpan.org/')); -print "not " unless $u eq $u->rel('http://www.cpan.org/'); -print "ok 11\n"; +is($u, $u->rel('http://www.cpan.org/')); @@ -1,59 +1,42 @@ use strict; use warnings; -print "1..17\n"; +use Test::More tests => 17; use URI::Split qw(uri_join uri_split); sub j { join("-", map { defined($_) ? $_ : "<undef>" } @_) } -print "not " unless j(uri_split("p")) eq "<undef>-<undef>-p-<undef>-<undef>"; -print "ok 1\n"; +is j(uri_split("p")), "<undef>-<undef>-p-<undef>-<undef>"; -print "not " unless j(uri_split("p?q")) eq "<undef>-<undef>-p-q-<undef>"; -print "ok 2\n"; +is j(uri_split("p?q")), "<undef>-<undef>-p-q-<undef>"; -print "not " unless j(uri_split("p#f")) eq "<undef>-<undef>-p-<undef>-f"; -print "ok 3\n"; +is j(uri_split("p#f")), "<undef>-<undef>-p-<undef>-f"; -print "not " unless j(uri_split("p?q/#f/?")) eq "<undef>-<undef>-p-q/-f/?"; -print "ok 4\n"; +is j(uri_split("p?q/#f/?")), "<undef>-<undef>-p-q/-f/?"; -print "not " unless j(uri_split("s://a/p?q#f")) eq "s-a-/p-q-f"; -print "ok 5\n"; +is j(uri_split("s://a/p?q#f")), "s-a-/p-q-f"; -print "not " unless uri_join("s", "a", "/p", "q", "f") eq "s://a/p?q#f"; -print "ok 6\n"; +is uri_join("s", "a", "/p", "q", "f"), "s://a/p?q#f"; -print "not " unless uri_join("s", "a", "p", "q", "f") eq "s://a/p?q#f"; -print "ok 7\n"; +is uri_join("s", "a", "p", "q", "f"), "s://a/p?q#f"; -print "not " unless uri_join(undef, undef, "", undef, undef) eq ""; -print "ok 8\n"; +is uri_join(undef, undef, "", undef, undef), ""; -print "not " unless uri_join(undef, undef, "p", undef, undef) eq "p"; -print "ok 9\n"; +is uri_join(undef, undef, "p", undef, undef), "p"; -print "not " unless uri_join("s", undef, "p") eq "s:p"; -print "ok 10\n"; +is uri_join("s", undef, "p"), "s:p"; -print "not " unless uri_join("s") eq "s:"; -print "ok 11\n"; +is uri_join("s"), "s:"; -print "not " unless uri_join() eq ""; -print "ok 12\n"; +is uri_join(), ""; -print "not " unless uri_join("s", "a") eq "s://a"; -print "ok 13\n"; +is uri_join("s", "a"), "s://a"; -print "not " unless uri_join("s", "a/b") eq "s://a%2Fb"; -print "ok 14\n"; +is uri_join("s", "a/b"), "s://a%2Fb"; -print "not " unless uri_join("s", ":/?#", ":/?#", ":/?#", ":/?#") eq "s://:%2F%3F%23/:/%3F%23?:/?%23#:/?#"; -print "ok 15\n"; +is uri_join("s", ":/?#", ":/?#", ":/?#", ":/?#"), "s://:%2F%3F%23/:/%3F%23?:/?%23#:/?#"; -print "not " unless uri_join(undef, undef, "a:b") eq "a%3Ab"; -print "ok 16\n"; +is uri_join(undef, undef, "a:b"), "a%3Ab"; -print "not " unless uri_join("s", undef, "//foo//bar") eq "s:////foo//bar"; -print "ok 17\n"; +is uri_join("s", undef, "//foo//bar"), "s:////foo//bar"; diff --git a/t/storable-test.pl b/t/storable-test.pl index 33deb6f..63ca5b1 100644 --- a/t/storable-test.pl +++ b/t/storable-test.pl @@ -11,17 +11,16 @@ if (@ARGV && $ARGV[0] eq "store") { print "# store\n"; store [URI->new("http://search.cpan.org")], 'urls.sto'; } else { - print "# retrieve\n"; + require Test::More; + Test::More->import(tests => 3); + note("retrieve"); my $a = retrieve 'urls.sto'; my $u = $a->[0]; #use Data::Dumper; print Dumper($a); - print "not " unless $u eq "http://search.cpan.org"; - print "ok 1\n"; + is($u, "http://search.cpan.org"); - print "not " unless $u->scheme eq "http"; - print "ok 2\n"; + is($u->scheme, "http"); - print "not " unless ref($u) eq "URI::http"; - print "ok 3\n"; + is(ref($u), "URI::http"); } diff --git a/t/storable.t b/t/storable.t index 20271e9..773ab45 100644 --- a/t/storable.t +++ b/t/storable.t @@ -2,7 +2,6 @@ use strict; use warnings; use Test::Needs 'Storable'; -print "1..3\n"; my $inc = -d "blib/lib" ? "blib/lib" : "lib"; system($^X, "-I$inc", "t/storable-test.pl", "store"); diff --git a/t/urn-isbn.t b/t/urn-isbn.t index a27a52d..cdc36eb 100644 --- a/t/urn-isbn.t +++ b/t/urn-isbn.t @@ -3,53 +3,39 @@ use warnings; use Test::Needs { 'Business::ISBN' => 3.005 }; -print "1..13\n"; +use Test::More tests => 13; use URI (); my $u = URI->new("URN:ISBN:0395363411"); -print "not " unless $u eq "URN:ISBN:0395363411" && - $u->scheme eq "urn" && - $u->nid eq "isbn"; -print "ok 1\n"; +ok($u eq "URN:ISBN:0395363411" && + $u->scheme eq "urn" && + $u->nid eq "isbn"); -print "not " unless $u->canonical eq "urn:isbn:0-395-36341-1"; -print "ok 2\n"; +is($u->canonical, "urn:isbn:0-395-36341-1"); -print "not " unless $u->isbn eq "0-395-36341-1"; -print "ok 3\n"; +is($u->isbn, "0-395-36341-1"); -print "not " unless $u->isbn_group_code == 0; -print "ok 4\n"; +is($u->isbn_group_code, 0); -print "not " unless $u->isbn_publisher_code == 395; -print "ok 5\n"; +is($u->isbn_publisher_code, 395); -print "not " unless $u->isbn13 eq "9780395363416"; -print "ok 6\n"; +is($u->isbn13, "9780395363416"); -print "not " unless $u->nss eq "0395363411"; -print "ok 7\n"; +is($u->nss, "0395363411"); -print "not " unless $u->isbn("0-88730-866-x") eq "0-395-36341-1"; -print "ok 8\n"; +is($u->isbn("0-88730-866-x"), "0-395-36341-1"); -print "not " unless $u->nss eq "0-88730-866-x"; -print "ok 9\n"; +is($u->nss, "0-88730-866-x"); -print "not " unless $u->isbn eq "0-88730-866-X"; -print "ok 10\n"; +is($u->isbn, "0-88730-866-X"); -print "not " unless URI::eq("urn:isbn:088730866x", "URN:ISBN:0-88-73-08-66-X"); -print "ok 11\n"; +ok(URI::eq("urn:isbn:088730866x", "URN:ISBN:0-88-73-08-66-X")); # try to illegal ones $u = URI->new("urn:ISBN:abc"); -print "not " unless $u eq "urn:ISBN:abc"; -print "ok 12\n"; - -print "not " if $u->nss ne "abc" || defined $u->isbn; -print "ok 13\n"; +is($u, "urn:ISBN:abc"); +ok($u->nss eq "abc" && !defined $u->isbn); diff --git a/t/urn-oid.t b/t/urn-oid.t index 8298749..a44b9e9 100644 --- a/t/urn-oid.t +++ b/t/urn-oid.t @@ -1,7 +1,7 @@ use strict; use warnings; -print "1..4\n"; +use Test::More tests => 4; use URI (); @@ -11,14 +11,10 @@ $u->oid(1..10); #print "$u\n"; -print "not " unless $u eq "urn:oid:1.2.3.4.5.6.7.8.9.10"; -print "ok 1\n"; +is($u, "urn:oid:1.2.3.4.5.6.7.8.9.10"); -print "not " unless $u->oid eq "1.2.3.4.5.6.7.8.9.10"; -print "ok 2\n"; +is($u->oid, "1.2.3.4.5.6.7.8.9.10"); -print "not " unless $u->scheme eq "urn" && $u->nid eq "oid"; -print "ok 3\n"; +ok($u->scheme eq "urn" && $u->nid eq "oid"); -print "not " unless $u->oid eq $u->nss; -print "ok 4\n"; +is($u->oid, $u->nss); |