From b4e78bce5be3ea7d82b61b875545e466a1d7d0bd Mon Sep 17 00:00:00 2001
From: petdance <petdance@fa6c7475-4f37-0410-a643-9d661a9e9720>
Date: Mon, 22 Dec 2008 22:28:34 +0000
Subject: [PATCH] working on autolint tests

---
 Mechanize.pm | 31 ++++++++++++++++++++++++++-----
 t/autolint.t | 20 +++++++++++++++-----
 2 files changed, 41 insertions(+), 10 deletions(-)

diff --git a/Mechanize.pm b/Mechanize.pm
index f252687..5938837 100644
--- 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
index 187ecfb..e142184 100644
--- 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;