1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
#!/usr/bin/env perl -T
use strict;
use warnings;
use Test::Builder::Tester;
use Test::More;
use URI::file;
use Test::WWW::Mechanize;
BEGIN {
my $module = 'HTML::Lint 2.20';
# Load HTML::Lint here for the imports
if ( not eval "use $module; 1;" ) {
plan skip_all => "$module is not installed, cannot test autolint";
}
plan tests => 27;
}
ACCESSOR_MUTATOR: {
my $lint = HTML::Lint->new( only_types => HTML::Lint::Error::STRUCTURE );
ACCESSOR: {
my $mech = Test::WWW::Mechanize->new();
ok( !$mech->autolint(), 'no autolint to new yields autolint off' );
$mech = Test::WWW::Mechanize->new( autolint => undef );
ok( !$mech->autolint(), 'undef to new yields autolint off' );
$mech = Test::WWW::Mechanize->new( autolint => 0 );
ok( !$mech->autolint(), '0 to new yields autolint off' );
$mech = Test::WWW::Mechanize->new( autolint => 1 );
ok( $mech->autolint(), '1 to new yields autolint on' );
$mech = Test::WWW::Mechanize->new( autolint => [] );
ok( $mech->autolint(), 'non-false, non-object to new yields autolint on' );
$mech = Test::WWW::Mechanize->new( autolint => $lint );
ok( $mech->autolint(), 'HTML::Lint object to new yields autolint on' );
}
MUTATOR: {
my $mech = Test::WWW::Mechanize->new();
ok( !$mech->autolint(0), '0 returns autolint off' );
ok( !$mech->autolint(), '0 autolint really off' );
ok( !$mech->autolint(''), '"" returns autolint off' );
ok( !$mech->autolint(), '"" autolint really off' );
ok( !$mech->autolint(1), '1 returns autolint off (prior state)' );
ok( $mech->autolint(), '1 autolint really on' );
ok( $mech->autolint($lint), 'HTML::Lint object returns autolint on (prior state)' );
ok( $mech->autolint(), 'HTML::Lint object autolint really on' );
my $ret = $mech->autolint( 0 );
isa_ok( $ret, 'HTML::Lint' );
ok( !$mech->autolint(), 'autolint off after nuking HTML::Lint object' );
}
}
FLUFFY_PAGE_HAS_ERRORS: {
my $mech = Test::WWW::Mechanize->new( autolint => 1 );
isa_ok( $mech, 'Test::WWW::Mechanize' );
my $uri = URI::file->new_abs( 't/fluffy.html' )->as_string;
test_out( "not ok 1 - GET $uri" );
test_fail( +5 );
test_err( "# HTML::Lint errors for $uri" );
test_err( '# (10:9) <img src="/foo.gif"> tag has no HEIGHT and WIDTH attributes' );
test_err( '# (10:9) <img src="/foo.gif"> does not have ALT text defined' );
test_err( '# 2 errors on the page' );
$mech->get_ok( $uri );
test_test( 'Fluffy page should have fluffy errors' );
}
CUSTOM_LINTER_IGNORES_FLUFFY_ERRORS: {
my $lint = HTML::Lint->new( only_types => HTML::Lint::Error::STRUCTURE );
my $mech = Test::WWW::Mechanize->new( autolint => $lint );
isa_ok( $mech, 'Test::WWW::Mechanize' );
my $uri = URI::file->new_abs( 't/fluffy.html' )->as_string;
$mech->get_ok( $uri, 'Fluffy page should not have errors' );
# And if we go to another page, the autolint object has been reset.
$mech->get_ok( $uri, 'Second pass at the fluffy page should not have errors, either' );
}
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/good.html' )->as_string;
$mech->get_ok( $uri );
test_out( "ok 1 - GET $uri" );
$mech->get_ok( $uri, "GET $uri" );
test_test( 'Good GET, good HTML' );
}
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/bad.html' )->as_string;
# Test via get_ok
test_out( "not ok 1 - GET $uri" );
test_fail( +6 );
test_err( "# HTML::Lint errors for $uri" );
test_err( '# (7:9) Unknown attribute "hrex" for tag <a>' );
test_err( '# (8:33) </b> with no opening <b>' );
test_err( '# (9:5) <a> at (8:9) is never closed' );
test_err( '# 3 errors on the page' );
$mech->get_ok( $uri, "GET $uri" );
test_test( 'get_ok complains about bad HTML' );
# Test via follow_link_ok
test_out( 'not ok 1 - Following link back to bad.html' );
test_fail( +6 );
test_err( "# HTML::Lint errors for $uri" );
test_err( '# (7:9) Unknown attribute "hrex" for tag <a>' );
test_err( '# (8:33) </b> with no opening <b>' );
test_err( '# (9:5) <a> at (8:9) is never closed' );
test_err( '# 3 errors on the page' );
$mech->follow_link_ok( { text => 'Back to bad' }, 'Following link back to bad.html' );
test_test( 'follow_link_ok complains about bad HTML' );
}
done_testing();
|
