[Catalyst-commits] r8779 - in Catalyst-Runtime/5.80/trunk: lib t

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2008-12-07 18:31:30 +0000 (Sun, 07 Dec 2008)
New Revision: 8779

Modified:
   Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
   Catalyst-Runtime/5.80/trunk/t/unit_core_uri_for.t
Log:
Test and fix for a case which caused uri_for to generate a double slash at the start of paths

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-07 10:48:58 UTC (rev 8778)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-07 18:31:30 UTC (rev 8779)
@@ -1077,7 +1077,7 @@
     # join args with '/', or a blank string
     my $args = join('/', grep { defined($_) } @args);
     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
-    $args =~ s!^/!!;
+    $args =~ s!^/+!!;
     my $base = $c->req->base;
     my $class = ref($base);
     $base =~ s{(?<!/)$}{/};

Modified: Catalyst-Runtime/5.80/trunk/t/unit_core_uri_for.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_core_uri_for.t	2008-12-07 10:48:58 UTC (rev 8778)
+++ Catalyst-Runtime/5.80/trunk/t/unit_core_uri_for.t	2008-12-07 18:31:30 UTC (rev 8779)
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 16;
 use URI;
 
 use_ok('Catalyst');
@@ -103,3 +103,8 @@
     is( $warnings, 0, "no warnings emitted" );
 }
 
+# Test with parameters '/', 'foo', 'bar' - should not generate a //
+is( Catalyst::uri_for( $context, qw| / foo bar | )->as_string,
+    'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar'
+);
+