If an object is passed to HTTP::Request, it must provide a canonical()

I ran into this issue today when I tried to GET a Mojo::URL object.  No
error was thrown until HTTP::Request tried to call the canonical()
method on the object.  So, just checking if an object provides a
scheme() method is not enough.

Author: oalders

Changes

@@ -1,6 +1,8 @@
 Revision history for HTTP-Message
 
 {{$NEXT}}
+    - If an object is passed to HTTP::Request, it must provide a canonical()
+      method (Olaf Alders)
 
 6.11   2015-09-09
     - fix an undefined value warning in HTTP::Headers::as_string

lib/HTTP/Request.pm

@@ -65,7 +65,7 @@ sub uri
 	    Carp::croak("A URI can't be a " . ref($uri) . " reference")
 		if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
 	    Carp::croak("Can't use a " . ref($uri) . " object as a URI")
-		unless $uri->can('scheme');
+		unless $uri->can('scheme') && $uri->can('canonical');
 	    $uri = $uri->clone;
 	    unless ($HTTP::URI_CLASS eq "URI") {
 		# Argh!! Hate this... old LWP legacy!

t/request.t

@@ -5,7 +5,8 @@ use strict;
 use warnings;
 
 use Test::More;
-plan tests => 11;
+use Test::Fatal qw( dies_ok lives_ok );
+plan tests => 15;
 
 use HTTP::Request;
 
@@ -31,3 +32,41 @@ is($r2->method, "DELETE");
 is($r2->uri, "http:");
 is($r2->protocol, "HTTP/1.1");
 is($r2->header("Accept-Encoding"), $req->header("Accept-Encoding"));
+
+# Test objects which are accepted as URI-like
+{
+    package Foo::URI;
+
+    use strict;
+    use warnings;
+
+    sub new { return bless {}, shift; }
+    sub clone  { return shift }
+    sub scheme { }
+
+    1;
+
+    package Foo::URI::WithCanonical;
+
+    sub new { return bless {}, shift; }
+    sub clone     { return shift }
+    sub scheme    { }
+    sub canonical { }
+
+    1;
+
+    package main;
+
+    ok( Foo::URI->new->can( 'scheme' ), 'Object can scheme()' );
+    dies_ok(
+        sub { HTTP::Request->new( GET => Foo::URI->new ) },
+        'Object without canonical method triggers an exception'
+    );
+
+    ok( Foo::URI::WithCanonical->new->can( 'canonical' ),
+        'Object can canonical()' );
+    lives_ok(
+        sub { HTTP::Request->new( GET => Foo::URI::WithCanonical->new ) },
+        'Object with canonical method does not trigger an exception'
+    );
+}