[dw-free] Make /create-url.t report failures on more useful line

[fu]

[commit: http://hg.dwscoalition.org/dw-free/rev/5fe1dc7c915a]

http://bugs.dwscoalition.org/show_bug.cgi?id=3552

Use subtests + $Test::Builder::Level to be able to more accurately pinpoint
the line number where a test fails.

Patch by exor674.

Files modified:

• t/create-url.t

--------------------------------------------------------------------------------
diff -r 684da270b0c6 -r 5fe1dc7c915a t/create-url.t
--- a/t/create-url.t	Tue Mar 01 15:18:23 2011 +0800
+++ b/t/create-url.t	Tue Mar 01 15:22:55 2011 +0800
@@ -1,6 +1,6 @@
 # -*-perl-*-
 use strict;
-use Test::More tests => 5 * 19; # replace last number with the number of check_req calls
+use Test::More tests => 19; # replace this number with the number of check_req calls
 use lib "$ENV{LJHOME}/cgi-bin";
 
 require 'ljlib.pl';
@@ -253,17 +253,25 @@ sub check_req {
 sub check_req {
     my ( $url, $path, $opts, $eopts, $expected ) = @_;
 
-    my $rq = HTTP::Request->new(GET => $url);
-    my ( $https, $host ) = $url =~ m!^(http(?:s)?)://(.+?)/!;
-    $LJ::IS_SSL = ( $https eq 'https' ) ? 1 : 0;
-    $rq->header("Host", $host);
+    # Telling Test::Builder ( which Test::More uses ) to
+    # look one level further up the call stack.
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-    DW::Request->reset;
-    my $r = DW::Request::Standard->new($rq);
+    subtest $url, sub {
+        plan tests => 5;
 
-    my $nurl = LJ::create_url( $path, %$opts );
+        my $rq = HTTP::Request->new(GET => $url);
+        my ( $https, $host ) = $url =~ m!^(http(?:s)?)://(.+?)/!;
+        $LJ::IS_SSL = ( $https eq 'https' ) ? 1 : 0;
+        $rq->header("Host", $host);
 
-    validate_req($nurl,$eopts,$expected);
+        DW::Request->reset;
+        my $r = DW::Request::Standard->new($rq);
+
+        my $nurl = LJ::create_url( $path, %$opts );
+
+        validate_req($nurl,$eopts,$expected);
+    };
 }
 
 sub validate_req {
@@ -288,17 +296,19 @@ sub validate_req {
 
     is( $fragment, $eopts->{fragment}, "invalid fragment" );
 
-    my $fail = '';
     my $args = $r->get_args;
 
-    foreach my $k ( keys %$args ) {
-        if ( $args->{$k} ne $expected->{$k} ) {
-            $fail .= "$k ( $args->{$k} != $expected->{$k} ), ";
+    subtest "args", sub {
+        my $tests_run = 0;
+        foreach my $k ( keys %$args ) {
+            is( $args->{$k}, $expected->{$k}, "argument '$k'");
+            delete $expected->{$k};
+            $tests_run++;
         }
-        delete $expected->{$k};
-    }
-
-    $fail .= " -- missing: " . join(",", keys %$expected) if ( %$expected );
-
-    ok( ! $fail, "args mismatch: $fail");
+        foreach my $k ( keys %$expected ) {
+            is( $args->{$k}, $expected->{$k}, "argument '$k'");
+            $tests_run++;
+        }
+        ok("no argument tests") if $tests_run == 0;
+    };
 }
--------------------------------------------------------------------------------