working on autolint tests

petdance · Dec 22, 2008 · b4e78bc · b4e78bc
1 parent 6d9c22b
commit b4e78bc
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 10 deletions.
diff --git a/Mechanize.pm b/Mechanize.pm
@@ -181,7 +181,28 @@ sub get_ok {
         $url = $url->url if ref($url) eq 'WWW::Mechanize::Link';
         $desc = "GET $url";
     }
-    $Test->ok( $ok, $desc );
+
+    if ( $ok && $self->is_html && $self->{autolint} ) {
+        my $lint = HTML::Lint->new;
+        $lint->parse( $self->content );
+
+        my @errors = $lint->errors;
+        my $nerrors = @errors;
+        if ( $nerrors ) {
+            $ok = $Test->ok( 0, $desc );
+            $Test->diag( "HTML::Lint errors for $url" );
+            $Test->diag( $_->as_string ) for @errors;
+            my $s = $nerrors == 1 ? '' : 's';
+            $Test->diag( "$nerrors error$s on the page" );
+        }
+        else {
+            $ok = $Test->ok( 1, $desc );
+        }
+    }
+    else {
+        $Test->ok( $ok, $desc );
+    }
+
     if ( !$ok ) {
         $Test->diag( $self->status );
         $Test->diag( $self->response->message ) if $self->response;
@@ -510,25 +531,25 @@ sub html_lint_ok {
     my $ok;
 
     if ( $self->is_html ) {
-
+        # XXX Combine with the cut'n'paste version in get_ok()
         my $lint = HTML::Lint->new;
         $lint->parse( $self->content );
 
         my @errors = $lint->errors;
         my $nerrors = @errors;
         if ( $nerrors ) {
-            $ok = $Test->ok( 0, $msg );
+            $ok = $Test->ok( 0, $desc );
             $Test->diag( "HTML::Lint errors for $uri" );
             $Test->diag( $_->as_string ) for @errors;
             my $s = $nerrors == 1 ? '' : 's';
             $Test->diag( "$nerrors error$s on the page" );
         }
         else {
-            $ok = $Test->ok( 1, $msg );
+            $ok = $Test->ok( 1, $desc );
         }
     }
     else {
-        $ok = $Test->ok( 0, $msg );
+        $ok = $Test->ok( 0, $desc );
         $Test->diag( q{This page doesn't appear to be HTML, or didn't get the proper text/html content type returned.} );
     }
 

diff --git a/t/autolint.t b/t/autolint.t
@@ -4,7 +4,6 @@ use strict;
 use warnings;
 use Test::Builder::Tester;
 use Test::More;
-use URI::file;
 
 BEGIN {
     eval 'use HTML::Lint';
@@ -16,11 +15,18 @@ BEGIN {
     use_ok( 'Test::WWW::Mechanize' );
 }
 
+use lib 't';
+use TestServer;
+
+my $server      = TestServer->new;
+my $pid         = $server->background;
+my $server_root = $server->root;
+
 GOOD_GET_GOOD_HTML: {
     my $mech = Test::WWW::Mechanize->new( autolint => 1 );
     isa_ok( $mech, 'Test::WWW::Mechanize' );
 
-    my $uri = URI::file->new_abs( 't/html/good.html' )->as_string;
+    my $uri = "$server_root/good.html";
 
     test_out( 'ok 1 - GET good.html' );
     $mech->get_ok( $uri, 'GET good.html' );
@@ -31,7 +37,7 @@ GOOD_GET_BAD_HTML: {
     my $mech = Test::WWW::Mechanize->new( autolint => 1 );
     isa_ok( $mech, 'Test::WWW::Mechanize' );
 
-    my $uri = URI::file->new_abs( 't/html/bad.html' )->as_string;
+    my $uri = "$server_root/bad.html";
 
     test_out( 'not ok 1 - GET bad.html' );
     test_fail( +5 );
@@ -48,10 +54,14 @@ BAD_GET: {
     my $mech = Test::WWW::Mechanize->new( autolint => 1 );
     isa_ok( $mech, 'Test::WWW::Mechanize' );
 
-    my $uri = URI::file->new_abs( 't/html/nonexistent.html' )->as_string;
+    my $uri = "$server_root/nonexistent.html";
 
     test_out( 'not ok 1 - GET nonexistent.html' );
-    test_fail( +1 );
+    test_fail( +3 );
+    test_diag( '404' );
+    test_diag( qq{File `$uri' does not exist} );
     $mech->get_ok( $uri, 'GET nonexistent.html' );
     test_test( 'Bad GET' );
 }
+
+$server->stop;