Make URI module pass tests needed for integration with LWP::Simple. A…

…dd default_port method like p5.

lib/URI.pm

@@ -47,23 +47,23 @@ method parse (Str $str) {
     # now deprecated
     $!uri = $!grammar.parse_result;
 
-    my $comp_container = $!grammar.parse_result<URI_reference><URI> //
+    my $comp_container = $!grammar.parse_result<URI_reference><URI> ||
         $!grammar.parse_result<URI_reference><relative_ref>;
     $!scheme = $comp_container<scheme>;
     $!query = $comp_container<query>;
     $!frag = $comp_container<fragment>;
-    $comp_container = $comp_container<hier_part> // $comp_container<relative_part>;
+    $comp_container = $comp_container<hier_part> || $comp_container<relative_part>;
 
     $!authority = $comp_container<authority>;
-    $!path =    $comp_container<path_abempty>       //
+    $!path =    $comp_container<path_abempty>       ||
                 $comp_container<path_absolute>      ;
-    $!is_absolute = ?($!path // $.scheme);
+    $!is_absolute = ?($!path || $!scheme);
 
-    $!path //=  $comp_container<path_noscheme>      //
+    $!path ||=  $comp_container<path_noscheme>      ||
                 $comp_container<path_rootless>      ;
 
-    @!segments = $!path<segment>.list() // ('');
-    if my $first_chunk = $!path<segment_nz_nc> // $!path<segment_nz> {
+    @!segments = $!path<segment>.list() || ('');
+    if my $first_chunk = $!path<segment_nz_nc> || $!path<segment_nz> {
         unshift @!segments, $first_chunk;
     }
     if @!segments.elems == 0 {
@@ -142,20 +142,25 @@ method authority {
 }
 
 method host {
-    return ($!authority<host> // '').lc;
+    return ($!authority<host> || '').lc;
+}
+
+method default_port {
+	URI::DefaultPort::scheme_port($.scheme)
 }
 
 method _port {
 	# port 0 is off limits and see also RT 96424
-    item $!authority<port> || Int;
+	# $!authority<port>.Int doesn't work because of RT 96472
+    $!authority<port> ?? ($!authority<port> ~ '').Int !! Int;
 }
 
 method port {
-	$._port // URI::DefaultPort::scheme_port($.scheme);
+	$._port // $.default_port;
 }
 
 method path {
-    return ~($!path // '').lc;
+    return ~($!path || '');
 }
 
 method absolute {
@@ -167,10 +172,16 @@ method relative {
 }
 
 method query {
-    item ~($!query // '');
+    item ~($!query || '');
+}
+
+method path_query {
+	$.query ?? $.path ~ '?' ~ $.query !! $.path
 }
+
+
 method frag {
-    return ~($!frag // '').lc;
+    return ~($!frag || '').lc;
 }
 
 method fragment { $.frag }

lib/URI/DefaultPort.pm

@@ -29,7 +29,7 @@ package URI::DefaultPort {
 
 	our sub scheme_port(Str $scheme) {
 		# guessing the // Int should be unnecessary some day ...
-		return  %default_port{$scheme} // Int;
+		return  %default_port{$scheme}.Int // Int;
 	}
 
 }

t/lwp-simple.t

@@ -0,0 +1,53 @@
+#
+# Test URI capabilities needed for the LWP::Simple parse_url() method
+#
+
+use v6;
+use Test;
+
+use URI;
+
+my @test = (
+    'Simple URL without path',
+        'http://www.rakudo.org',
+        ['http', 'www.rakudo.org', 80, ''],
+
+    'Port other than 80',
+        'http://www.altavista.com:81/',
+        ['http', 'www.altavista.com', 81, '/'],
+
+    'HTTPS scheme, and default port != 80',
+        'https://www.rakudo.org/rakudo-latest.tar.bz2',
+        ['https', 'www.rakudo.org', 443, '/rakudo-latest.tar.bz2'],
+
+    '#GH-1 http://github.com/cosimo/perl6-lwp-simple/issues/#issue/1',
+        'http://www.c64.com/path/with/multiple/slashes/',
+        ['http', 'www.c64.com', 80, '/path/with/multiple/slashes/'],
+
+    'FTP url',
+        'ftp://get.opera.com/pub/opera/win/1054/en/Opera_1054_en_Setup.exe',
+        ['ftp', 'get.opera.com', 21, '/pub/opera/win/1054/en/Opera_1054_en_Setup.exe'],
+
+    'HTTP URL with double-slashes',
+        'http://tinyurl.com/api-create.php?url=http://digg.com',
+        ['http', 'tinyurl.com', 80, '/api-create.php?url=http://digg.com'],
+
+);
+
+for @test -> $test, $url, $results {
+	my $u = URI.new($url);
+    is($u.scheme, $results.[0], "Scheme for $url is $results.[0]");
+    is($u.host, $results.[1], "Hostname for $url is $results.[1]");
+    is($u.port, $results.[2], "Port for $url is $results.[2]");
+    is($u.path_query, $results.[3], "Path for $url is $results.[3]");
+}
+
+# Check that port is returned as a number,
+# or IO::Socket::INET.open() fails
+my $port = URI.new('http:5984//localhost/foo/test/').port;
+say $port;
+is($port.WHAT, 'Int()', 'port is returned as a Int, to avoid problems on sock.open()');
+
+done;
+
+

t/rfc-3986-examples.t

@@ -16,12 +16,12 @@ is($u.path, '/rfc/rfc2396.txt', 'http path');
 $u.parse('ldap://[2001:db8::7]/c=GB?objectClass?one');
 is($u.scheme, 'ldap', 'ldap scheme');
 is($u.host, '[2001:db8::7]', 'ldap host');
-is($u.path, '/c=gb', 'ldap path');
+is($u.path, '/c=GB', 'ldap path');
 is($u.query, 'objectClass?one', 'ldap query');
 
 $u.parse('mailto:John.Doe@example.com');
 is($u.scheme, 'mailto', 'mailto scheme');
-is($u.path, 'john.doe@example.com', 'news path');
+is($u.path, 'John.Doe@example.com', 'news path');
 
 $u.parse('news:comp.infosystems.www.servers.unix');
 is($u.scheme, 'news', 'news scheme');