r67704 - in /branches/upstream/liburi-perl/current: Changes META.yml Makefile.PL README URI.pm URI/Escape.pm URI/Heuristic.pm URI/_punycode.pm URI/_query.pm t/escape.t t/heuristic.t t/old-base.t t/query.t

angelabad-guest at users.alioth.debian.org angelabad-guest at users.alioth.debian.org
Sat Jan 22 21:05:15 UTC 2011


Author: angelabad-guest
Date: Sat Jan 22 21:04:49 2011
New Revision: 67704

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67704
Log:
[svn-upgrade] new version liburi-perl (1.57)

Modified:
    branches/upstream/liburi-perl/current/Changes
    branches/upstream/liburi-perl/current/META.yml
    branches/upstream/liburi-perl/current/Makefile.PL
    branches/upstream/liburi-perl/current/README
    branches/upstream/liburi-perl/current/URI.pm
    branches/upstream/liburi-perl/current/URI/Escape.pm
    branches/upstream/liburi-perl/current/URI/Heuristic.pm
    branches/upstream/liburi-perl/current/URI/_punycode.pm
    branches/upstream/liburi-perl/current/URI/_query.pm
    branches/upstream/liburi-perl/current/t/escape.t
    branches/upstream/liburi-perl/current/t/heuristic.t
    branches/upstream/liburi-perl/current/t/old-base.t
    branches/upstream/liburi-perl/current/t/query.t

Modified: branches/upstream/liburi-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/Changes?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/Changes (original)
+++ branches/upstream/liburi-perl/current/Changes Sat Jan 22 21:04:49 2011
@@ -1,3 +1,34 @@
+2011-01-22   Gisle Aas <gisle at ActiveState.com>
+
+  Release 1.57
+
+  Mark Stosberg (8):
+      typo fix: s/do deal/to deal/
+      best practice: s/foreach /for /
+      Whitespace: fix inconsistent use of tabs vs spaces
+      Code style: fix inconsistency with subroutine braces at the end of the     line vs below it.
+      Modernize: s/use vars/our/ ... since we require 5.6 as a minimum version now
+      Whitespace: fix indentation so blocks are consistently indented
+      Add formal terms "Percent-encode" and "Percent-decode" to the NAME and description to match the RFC
+      Drop support for Perl < 5.8.1         Perl 5.8 was released almost 10 years ago. It's time.
+
+  Gisle Aas (6):
+      Convert test to use Test::More
+      Adjust tests for query_form
+      Avoid "Use of uninitialized value"-noise from query_form
+      State test dependencies [RT#61538]
+      We also depend on ExtUtils::MakeMaker
+      State 5.8 dependency in the META.yml file
+
+  Ville Skyttä (2):
+      Guess HTTPS and FTP from URI::Heuristic input with port but no scheme.
+      Try harder to guess scheme from hostnames besides just "$scheme.*" ones.
+
+  John Miller (1):
+      Distingush between empty and undef values in query_form [RT#62708]
+
+
+
 2010-10-06   Gisle Aas <gisle at ActiveState.com>
 
    Release 1.56

Modified: branches/upstream/liburi-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/META.yml?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/META.yml (original)
+++ branches/upstream/liburi-perl/current/META.yml Sat Jan 22 21:04:49 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               URI
-version:            1.56
+version:            1.57
 abstract:           Uniform Resource Identifiers (absolute and relative)
 author:
     - Gisle Aas <gisle at activestate.com>
@@ -10,9 +10,11 @@
     ExtUtils::MakeMaker:  0
 build_requires:
     ExtUtils::MakeMaker:  0
+    Test:                 0
+    Test::More:           0
 requires:
     MIME::Base64:  2
-    perl:          5.006001
+    perl:          5.008001
 resources:
     MailingList:  mailto:libwww at perl.org
     repository:   http://gitorious.org/projects/perl-uri

Modified: branches/upstream/liburi-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/Makefile.PL?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/Makefile.PL (original)
+++ branches/upstream/liburi-perl/current/Makefile.PL Sat Jan 22 21:04:49 2011
@@ -1,4 +1,4 @@
-require 5.006001;
+require 5.008001;
 use ExtUtils::MakeMaker;
 
 if ("foo" !~ /\Afoo\z/) {
@@ -22,7 +22,7 @@
     'ABSTRACT'     => 'Uniform Resource Identifiers (absolute and relative)',
     'AUTHOR'       => 'Gisle Aas <gisle at activestate.com>',
     'LICENSE'      => 'perl',
-    'MIN_PERL_VERSION' => 5.006001,
+    'MIN_PERL_VERSION' => 5.008001,
     'PREREQ_PM'    => {	
 	'MIME::Base64' => 2,
     },
@@ -34,6 +34,11 @@
             'repository' => 'http://gitorious.org/projects/perl-uri',
             'MailingList' => 'mailto:libwww at perl.org',
         }
+    },
+    BUILD_REQUIRES => {
+	'ExtUtils::MakeMaker' => 0,
+	'Test' => 0,
+	'Test::More' => 0,
     },
 );
 

Modified: branches/upstream/liburi-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/README?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/README (original)
+++ branches/upstream/liburi-perl/current/README Sat Jan 22 21:04:49 2011
@@ -10,7 +10,7 @@
 Some tests require an Internet connection to work and are skipped if
 one is not active.
 
-You need perl-5.6.1 or better to install this package.  You should also
+You need perl-5.8.1 or better to install this package.  You should also
 have the MIME::Base64 module installed.  Installation is otherwise as
 usual:
 

Modified: branches/upstream/liburi-perl/current/URI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI.pm?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI.pm (original)
+++ branches/upstream/liburi-perl/current/URI.pm Sat Jan 22 21:04:49 2011
@@ -2,7 +2,7 @@
 
 use strict;
 use vars qw($VERSION);
-$VERSION = "1.56";
+$VERSION = "1.57";
 
 use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME $DEFAULT_QUERY_FORM_DELIMITER);
 

Modified: branches/upstream/liburi-perl/current/URI/Escape.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/Escape.pm?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/Escape.pm (original)
+++ branches/upstream/liburi-perl/current/URI/Escape.pm Sat Jan 22 21:04:49 2011
@@ -3,7 +3,7 @@
 
 =head1 NAME
 
-URI::Escape - Escape and unescape unsafe characters
+URI::Escape - Percent-encode and percent-decode unsafe characters
 
 =head1 SYNOPSIS
 
@@ -14,8 +14,10 @@
 
 =head1 DESCRIPTION
 
-This module provides functions to escape and unescape URI strings as
-defined by RFC 3986.
+This module provides functions to percent-encode and percent-decode URI strings as
+defined by RFC 3986. Percent-encoding URI's is informally called "URI escaping".
+This is the terminology used by this module, which predates the formalization of the
+terms by the RFC by several years.
 
 A URI consists of a restricted set of characters.  The restricted set
 of characters consists of digits, letters, and a few graphic symbols
@@ -72,22 +74,16 @@
 =item uri_escape_utf8( $string, $unsafe )
 
 Works like uri_escape(), but will encode chars as UTF-8 before
-escaping them.  This makes this function able do deal with characters
+escaping them.  This makes this function able to deal with characters
 with code above 255 in $string.  Note that chars in the 128 .. 255
 range will be escaped differently by this function compared to what
 uri_escape() would.  For chars in the 0 .. 127 range there is no
 difference.
 
-The call:
-
-    $uri = uri_escape_utf8($string);
-
-will be the same as:
-
-    use Encode qw(encode);
-    $uri = uri_escape(encode("UTF-8", $string));
-
-but will even work for perl-5.6 for chars in the 128 .. 255 range.
+Equivalent to:
+
+    utf8::encode($string);
+    my $uri = uri_escape($string);
 
 Note: JavaScript has a function called escape() that produces the
 sequence "%uXXXX" for chars in the 256 .. 65535 range.  This function
@@ -139,14 +135,12 @@
 
 =cut
 
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use vars qw(%escapes);
-
 require Exporter;
- at ISA = qw(Exporter);
- at EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
- at EXPORT_OK = qw(%escapes);
-$VERSION = "3.30";
+our @ISA = qw(Exporter);
+our %escapes;
+our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
+our @EXPORT_OK = qw(%escapes);
+our $VERSION = "3.30";
 
 use Carp ();
 
@@ -162,20 +156,19 @@
     RFC3986 => qr/[^A-Za-z0-9\-\._~]/,
 );
 
-sub uri_escape
-{
+sub uri_escape {
     my($text, $patn) = @_;
     return undef unless defined $text;
     if (defined $patn){
-	unless (exists  $subst{$patn}) {
-	    # Because we can't compile the regex we fake it with a cached sub
-	    (my $tmp = $patn) =~ s,/,\\/,g;
-	    eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
-	    Carp::croak("uri_escape: $@") if $@;
-	}
-	&{$subst{$patn}}($text);
+        unless (exists  $subst{$patn}) {
+            # Because we can't compile the regex we fake it with a cached sub
+            (my $tmp = $patn) =~ s,/,\\/,g;
+            eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
+            Carp::croak("uri_escape: $@") if $@;
+        }
+        &{$subst{$patn}}($text);
     } else {
-	$text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
+        $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
     }
     $text;
 }
@@ -185,32 +178,24 @@
     Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
 }
 
-sub uri_escape_utf8
-{
+sub uri_escape_utf8 {
     my $text = shift;
-    if ($] < 5.008) {
-	$text =~ s/([^\0-\x7F])/do {my $o = ord($1); sprintf("%c%c", 0xc0 | ($o >> 6), 0x80 | ($o & 0x3f)) }/ge;
-    }
-    else {
-	utf8::encode($text);
-    }
-
+    utf8::encode($text);
     return uri_escape($text, @_);
 }
 
-sub uri_unescape
-{
+sub uri_unescape {
     # Note from RFC1630:  "Sequences which start with a percent sign
     # but are not followed by two hexadecimal characters are reserved
     # for future extension"
     my $str = shift;
     if (@_ && wantarray) {
-	# not executed for the common case of a single argument
-	my @str = ($str, @_);  # need to copy
-	foreach (@str) {
-	    s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-	}
-	return @str;
+        # not executed for the common case of a single argument
+        my @str = ($str, @_);  # need to copy
+        for (@str) {
+            s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        }
+        return @str;
     }
     $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
     $str;

Modified: branches/upstream/liburi-perl/current/URI/Heuristic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/Heuristic.pm?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/Heuristic.pm (original)
+++ branches/upstream/liburi-perl/current/URI/Heuristic.pm Sat Jan 22 21:04:49 2011
@@ -152,11 +152,11 @@
     s/^\s+//;
     s/\s+$//;
 
-    if (/^(www|web|home)\./) {
+    if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i) {
 	$_ = "http://$_";
 
-    } elsif (/^(ftp|gopher|news|wais|http|https)\./) {
-	$_ = "$1://$_";
+    } elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i) {
+	$_ = lc($1) . "://$_";
 
     } elsif ($^O ne "MacOS" && 
 	    (m,^/,      ||          # absolute file name
@@ -179,6 +179,16 @@
     } elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/) {      # no scheme specified
 	if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/) {
 	    my $host = $1;
+
+	    my $scheme = "http";
+	    if (/^:(\d+)\b/) {
+		# Some more or less well known ports
+		if ($1 =~ /^[56789]?443$/) {
+		    $scheme = "https";
+		} elsif ($1 eq "21") {
+		    $scheme = "ftp";
+		}
+	    }
 
 	    if ($host !~ /\./ && $host ne "localhost") {
 		my @guess;
@@ -213,7 +223,7 @@
 		    print STDERR "no\n" if $DEBUG;
 		}
 	    }
-	    $_ = "http://$host$_";
+	    $_ = "$scheme://$host$_";
 
 	} else {
 	    # pure junk, just return it unchanged...

Modified: branches/upstream/liburi-perl/current/URI/_punycode.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/_punycode.pm?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/_punycode.pm (original)
+++ branches/upstream/liburi-perl/current/URI/_punycode.pm Sat Jan 22 21:04:49 2011
@@ -91,8 +91,7 @@
 
 sub encode_punycode {
     my $input = shift;
-    # my @input = split //, $input; # doesn't work in 5.6.x!
-    my @input = map substr($input, $_, 1), 0..length($input)-1;
+    my @input = split //, $input;
 
     my $n     = INITIAL_N;
     my $delta = 0;

Modified: branches/upstream/liburi-perl/current/URI/_query.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/_query.pm?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/_query.pm (original)
+++ branches/upstream/liburi-perl/current/URI/_query.pm Sat Jan 22 21:04:49 2011
@@ -46,10 +46,14 @@
 	    $key =~ s/ /+/g;
 	    $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
             for my $val (@$vals) {
-                $val = '' unless defined $val;
-		$val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
-                $val =~ s/ /+/g;
-                push(@query, "$key=$val");
+                if (defined $val) {
+		    $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
+		    $val =~ s/ /+/g;
+		    push(@query, "$key=$val");
+		}
+                else {
+                    push(@query, $key);
+                }
             }
         }
         if (@query) {
@@ -64,9 +68,8 @@
         }
     }
     return if !defined($old) || !length($old) || !defined(wantarray);
-    return unless $old =~ /=/; # not a form
-    map { s/\+/ /g; uri_unescape($_) }
-         map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
+    map { defined($_) ? do { s/\+/ /g; uri_unescape($_) } : undef }
+         map { /=/ ? split(/=/, $_, 2) : ($_ => undef)} split(/[&;]/, $old);
 }
 
 # Handle ...?dog+bones type of query

Modified: branches/upstream/liburi-perl/current/t/escape.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/escape.t?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/escape.t (original)
+++ branches/upstream/liburi-perl/current/t/escape.t Sat Jan 22 21:04:49 2011
@@ -31,11 +31,9 @@
 
 is uri_escape_utf8("|abcå"), "%7Cabc%C3%A5";
 
-SKIP: {
-    skip "Perl 5.8.0 or higher required", 3 if $] < 5.008;
+skip "Perl 5.8.0 or higher required", 3 if $] < 5.008;
 
-    ok !eval { print uri_escape("abc" . chr(300)); 1 };
-    like $@, qr/^Can\'t escape \\x{012C}, try uri_escape_utf8\(\) instead/;
+ok !eval { print uri_escape("abc" . chr(300)); 1 };
+like $@, qr/^Can\'t escape \\x{012C}, try uri_escape_utf8\(\) instead/;
 
-    is uri_escape_utf8(chr(0xFFF)), "%E0%BF%BF";
-}
+is uri_escape_utf8(chr(0xFFF)), "%E0%BF%BF";

Modified: branches/upstream/liburi-perl/current/t/heuristic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/heuristic.t?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/heuristic.t (original)
+++ branches/upstream/liburi-perl/current/t/heuristic.t Sat Jan 22 21:04:49 2011
@@ -12,7 +12,7 @@
     };
 }
 
-print "1..20\n";
+print "1..26\n";
 
 use URI::Heuristic qw(uf_urlstr uf_url);
 if (shift) {
@@ -116,4 +116,22 @@
 
     print "not " unless uf_urlstr("123.3.3.3:8080/foo") eq "http://123.3.3.3:8080/foo";
     print "ok 20\n";
+
+    print "not " unless uf_urlstr("123.3.3.3:443/foo") eq "https://123.3.3.3:443/foo";
+    print "ok 21\n";
+
+    print "not " unless uf_urlstr("123.3.3.3:21/foo") eq "ftp://123.3.3.3:21/foo";
+    print "ok 22\n";
+
+    print "not " unless uf_url("FTP.example.com")->scheme eq "ftp";
+    print "ok 23\n";
+
+    print "not " unless uf_url("ftp2.example.com")->scheme eq "ftp";
+    print "ok 24\n";
+
+    print "not " unless uf_url("ftp")->scheme eq "ftp";
+    print "ok 25\n";
+
+    print "not " unless uf_url("https.example.com")->scheme eq "https";
+    print "ok 26\n";
 }

Modified: branches/upstream/liburi-perl/current/t/old-base.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/old-base.t?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/old-base.t (original)
+++ branches/upstream/liburi-perl/current/t/old-base.t Sat Jan 22 21:04:49 2011
@@ -346,7 +346,7 @@
     die "\$url->query_form did not work"
       unless $a{a} eq 'foo' && $a{b} eq 'bar';
 
-    $url->query_form(a => undef, a => 'foo', '&=' => '&=+');
+    $url->query_form(a => '', a => 'foo', '&=' => '&=+');
     $url->_expect('as_string' => 'http://web?a=&a=foo&%26%3D=%26%3D%2B');
 
     my @a = $url->query_form;

Modified: branches/upstream/liburi-perl/current/t/query.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/query.t?rev=67704&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/query.t (original)
+++ branches/upstream/liburi-perl/current/t/query.t Sat Jan 22 21:04:49 2011
@@ -1,111 +1,86 @@
 #!perl -w
 
-print "1..23\n";
+use strict;
+use Test::More tests => 26;
 
-use strict;
 use URI ();
 my $u = URI->new("", "http");
 my @q;
 
 $u->query_form(a => 3, b => 4);
-
-print "not " unless $u eq "?a=3&b=4";
-print "ok 1\n";
+is $u, "?a=3&b=4";
 
 $u->query_form(a => undef);
-print "not " unless $u eq "?a=";
-print "ok 2\n";
+is $u, "?a";
+is_deeply [$u->query_form], [a => undef];
+
+$u->query_form(a => '');
+is $u, "?a=";
+is_deeply [$u->query_form], [a => ''];
 
 $u->query_form("a[=&+#] " => " [=&+#]");
-print "not " unless $u eq "?a%5B%3D%26%2B%23%5D+=+%5B%3D%26%2B%23%5D";
-print "ok 3\n";
+is $u, "?a%5B%3D%26%2B%23%5D+=+%5B%3D%26%2B%23%5D";
 
 @q = $u->query_form;
-print "not " unless join(":", @q) eq "a[=&+#] : [=&+#]";
-print "ok 4\n";
+is join(":", @q), "a[=&+#] : [=&+#]";
 
 @q = $u->query_keywords;
-print "not " if @q;
-print "ok 5\n";
+ok !@q;
 
 $u->query_keywords("a", "b");
-print "not " unless $u eq "?a+b";
-print "ok 6\n";
+is $u, "?a+b";
 
 $u->query_keywords(" ", "+", "=", "[", "]");
-print "not " unless $u eq "?%20+%2B+%3D+%5B+%5D";
-print "ok 7\n";
+is $u, "?%20+%2B+%3D+%5B+%5D";
 
 @q = $u->query_keywords;
-print "not " unless join(":", @q) eq " :+:=:[:]";
-print "ok 8\n";
+is join(":", @q), " :+:=:[:]";
 
 @q = $u->query_form;
-print "not " if @q;
-print "ok 9\n";
+is_deeply \@q, ['  + = [ ]', undef];
 
 $u->query(" +?=#");
-print "not " unless $u eq "?%20+?=%23";
-print "ok 10\n";
+is $u, "?%20+?=%23";
 
 $u->query_keywords([qw(a b)]);
-print "not " unless $u eq "?a+b";
-print "ok 11\n";
+is $u, "?a+b";
 
 $u->query_keywords([]);
-print "not " unless $u eq "";
-print "ok 12\n";
+is $u, "";
 
 $u->query_form({ a => 1, b => 2 });
-print "not " unless $u eq "?a=1&b=2" || $u eq "?b=2&a=1";
-print "ok 13\n";
+ok $u eq "?a=1&b=2" || $u eq "?b=2&a=1";
 
 $u->query_form([ a => 1, b => 2 ]);
-print "not " unless $u eq "?a=1&b=2";
-print "ok 14\n";
+is $u, "?a=1&b=2";
 
 $u->query_form({});
-print "not " unless $u eq "";
-print "ok 15\n";
+is $u, "";
 
 $u->query_form([a => [1..4]]);
-print "not " unless $u eq "?a=1&a=2&a=3&a=4";
-print "ok 16\n";
+is $u, "?a=1&a=2&a=3&a=4";
 
 $u->query_form([]);
-print "not " unless $u eq "";
-print "ok 17\n";
+is $u, "";
 
 $u->query_form(a => { foo => 1 });
-print "not " unless "$u" =~ /^\?a=HASH\(/;
-print "ok 18\n";
+ok "$u" =~ /^\?a=HASH\(/;
 
 $u->query_form(a => 1, b => 2, ';');
-print "not " unless $u eq "?a=1;b=2";
-print "ok 19\n";
+is $u, "?a=1;b=2";
 
 $u->query_form(a => 1, c => 2);
-print "not " unless $u eq "?a=1;c=2";
-print "ok 20\n";
+is $u, "?a=1;c=2";
 
 $u->query_form(a => 1, c => 2, '&');
-print "not " unless $u eq "?a=1&c=2";
-print "ok 21\n";
+is $u, "?a=1&c=2";
 
 $u->query_form([a => 1, b => 2], ';');
-print "not " unless $u eq "?a=1;b=2";
-print "ok 22\n";
+is $u, "?a=1;b=2";
 
 $u->query_form([]);
 {
     local $URI::DEFAULT_QUERY_FORM_DELIMITER = ';';
     $u->query_form(a => 1, b => 2);
 }
-print "not " unless $u eq "?a=1;b=2";
-print "ok 23\n";
-
-__END__
-# Some debugging while writing new tests
-print "\@q='", join(":", @q), "'\n";
-print "\$u='$u'\n";
-
+is $u, "?a=1;b=2";




More information about the Pkg-perl-cvs-commits mailing list