r11428 - in /trunk/libtest-www-mechanize-perl: ./ debian/ t/
hanska-guest at users.alioth.debian.org
hanska-guest at users.alioth.debian.org
Wed Dec 19 14:45:50 UTC 2007
Author: hanska-guest
Date: Wed Dec 19 14:45:50 2007
New Revision: 11428
URL: http://svn.debian.org/wsvn/?sc=1&rev=11428
Log:
* New upstream release
Modified:
trunk/libtest-www-mechanize-perl/Changes
trunk/libtest-www-mechanize-perl/META.yml
trunk/libtest-www-mechanize-perl/Makefile.PL
trunk/libtest-www-mechanize-perl/Mechanize.pm
trunk/libtest-www-mechanize-perl/debian/changelog
trunk/libtest-www-mechanize-perl/t/content_contains.t
trunk/libtest-www-mechanize-perl/t/content_lacks.t
trunk/libtest-www-mechanize-perl/t/follow_link_ok.t
trunk/libtest-www-mechanize-perl/t/followable_links.t
trunk/libtest-www-mechanize-perl/t/get_ok.t
trunk/libtest-www-mechanize-perl/t/has_tag.t
trunk/libtest-www-mechanize-perl/t/html_lint_ok.t
trunk/libtest-www-mechanize-perl/t/link_content.t
trunk/libtest-www-mechanize-perl/t/link_status.t
trunk/libtest-www-mechanize-perl/t/links_ok.t
trunk/libtest-www-mechanize-perl/t/page_links_content.t
trunk/libtest-www-mechanize-perl/t/page_links_ok.t
trunk/libtest-www-mechanize-perl/t/stuff_inputs.t
trunk/libtest-www-mechanize-perl/t/submit_form_ok.t
Modified: trunk/libtest-www-mechanize-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/Changes?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Changes (original)
+++ trunk/libtest-www-mechanize-perl/Changes Wed Dec 19 14:45:50 2007
@@ -1,12 +1,24 @@
Revision history for Test-WWW-Mechanize
+
+WWW::Mechanize and Test::WWW::Mechanize do not use rt.cpan.org for
+bug tracking. They are now being tracked via Google Code at
+http://code.google.com/p/www-mechanize/issues/list
+
+
+1.18 Thu Dec 6 10:12:14 CST 2007
+------------------------------------
+[ENHANCEMENTS]
+Added default descriptions for most test assertions.
+
+[FIXES]
+HTML::Lint is now properly optional.
+
+Added delays in all the tests that use HTTP::Server::Simple to give
+it time to correctly fire up.
+
1.16 Mon Oct 29 15:34:21 CDT 2007
------------------------------------
-Please note that WWW::Mechanize and Test::WWW::Mechanize are no
-longer using rt.cpan.org for bug tracking. They are now being
-tracked via Google Code at
-http://code.google.com/p/www-mechanize/issues/list
-
[ENHANCEMENTS]
Added $mech->post_ok(). Thanks, Greg Sheard.
Modified: trunk/libtest-www-mechanize-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/META.yml?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/META.yml (original)
+++ trunk/libtest-www-mechanize-perl/META.yml Wed Dec 19 14:45:50 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Test-WWW-Mechanize
-version: 1.16
+version: 1.18
version_from: Mechanize.pm
installdirs: site
requires:
Modified: trunk/libtest-www-mechanize-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/Makefile.PL?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Makefile.PL (original)
+++ trunk/libtest-www-mechanize-perl/Makefile.PL Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use warnings;
use ExtUtils::MakeMaker;
-WriteMakefile(
+my $parms = {
NAME => 'Test::WWW::Mechanize',
AUTHOR => 'Andy Lester <andy at petdance.com>',
VERSION_FROM => 'Mechanize.pm',
@@ -19,7 +19,18 @@
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Test-WWW-Mechanize-*' },
-);
+};
+
+if ( $ExtUtils::MakeMaker::VERSION eq '6.36' ) {
+ $parms->{EXTRA_META} = <<EOF;
+resources:
+ homepage: http://code.google.com/p/www-mechanize/
+ bugtracker: http://code.google.com/p/www-mechanize/issues/list
+EOF
+ }
+
+WriteMakefile( %{$parms} );
+
sub MY::postamble {
return <<'MAKE_FRAG';
Modified: trunk/libtest-www-mechanize-perl/Mechanize.pm
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/Mechanize.pm?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Mechanize.pm (original)
+++ trunk/libtest-www-mechanize-perl/Mechanize.pm Wed Dec 19 14:45:50 2007
@@ -6,11 +6,11 @@
=head1 VERSION
-Version 1.16
-
-=cut
-
-our $VERSION = '1.16';
+Version 1.18
+
+=cut
+
+our $VERSION = '1.18';
=head1 SYNOPSIS
@@ -42,6 +42,23 @@
but has nicer diagnostics if they fail.
+Default descriptions will be supplied for most methods if you omit them. e.g.
+
+ my $mech = Test::WWW::Mechanize->new;
+ $mech->get_ok( 'http://petdance.com/' );
+ $mech->base_is( 'http://petdance.com/' );
+ $mech->title_is( "Invoice Status" );
+ $mech->content_contains( "Andy Lester" );
+ $mech->content_like( qr/(cpan|perl)\.org/ );
+
+results in
+
+ ok - Got 'http://petdance.com/' ok
+ ok - Base is 'http://petdance.com/'
+ ok - Title is 'Invoice Status'
+ ok - Content contains 'Andy Lester'
+ ok - Content is like '(?-xism:(cpan|perl)\.org)'
+
=cut
use warnings;
@@ -118,7 +135,10 @@
$self->get( $url, %opts );
my $ok = $self->success;
- $desc = "GET $url" unless defined $desc;
+ if ( not defined $desc ) {
+ $url = $url->url if ref($url) eq 'WWW::Mechanize::Link';
+ $desc = "GET $url";
+ }
$Test->ok( $ok, $desc );
if ( !$ok ) {
$Test->diag( $self->status );
@@ -165,7 +185,10 @@
}
} # parms left
- $desc = "POST to $url" unless defined $desc;
+ if ( not defined $desc ) {
+ $url = $url->url if ref($url) eq 'WWW::Mechanize::Link';
+ $desc = "POST $url";
+ }
$self->post( $url, \%opts );
my $ok = $self->success;
$Test->ok( $ok, $desc );
@@ -178,7 +201,7 @@
}
-=head2 submit_form_ok( \%parms [, $comment] )
+=head2 submit_form_ok( \%parms [, $desc] )
Makes a C<submit_form()> call and executes tests on the results.
The form must be found, and then submitted successfully. Otherwise,
@@ -190,7 +213,7 @@
$agent->submit_form_ok( {n=>3}, "looking for 3rd link" );
-As with other test functions, C<$comment> is optional. If it is supplied
+As with other test functions, C<$desc> is optional. If it is supplied
then it will display when running the test harness in verbose mode.
Returns true value if the specified link was found and followed
@@ -202,7 +225,7 @@
sub submit_form_ok {
my $self = shift;
my $parms = shift || {};
- my $comment = shift;
+ my $desc = shift;
if ( ref $parms ne 'HASH' ) {
Carp::croak "FATAL: parameters must be given as a hashref";
@@ -225,14 +248,14 @@
}
}
- $Test->ok( $ok, $comment );
+ $Test->ok( $ok, $desc );
$Test->diag( $error ) if $error;
return $ok;
}
-=head2 $mech->follow_link_ok( \%parms [, $comment] )
+=head2 $mech->follow_link_ok( \%parms [, $desc] )
Makes a C<follow_link()> call and executes tests on the results.
The link must be found, and then followed successfully. Otherwise,
@@ -244,7 +267,7 @@
$mech->follow_link_ok( {n=>3}, "looking for 3rd link" );
-As with other test functions, C<$comment> is optional. If it is supplied
+As with other test functions, C<$desc> is optional. If it is supplied
then it will display when running the test harness in verbose mode.
Returns a true value if the specified link was found and followed
@@ -256,7 +279,12 @@
sub follow_link_ok {
my $self = shift;
my $parms = shift || {};
- my $comment = shift;
+ my $desc = shift;
+
+ if (!defined($desc)) {
+ my $parms_str = join(", ", map { join("=", $_, $parms->{$_}) } keys(%$parms));
+ $desc = "Followed link with '$parms_str'" if !defined($desc);
+ }
if ( ref $parms ne 'HASH' ) {
Carp::croak "FATAL: parameters must be given as a hashref";
@@ -279,7 +307,7 @@
}
}
- $Test->ok( $ok, $comment );
+ $Test->ok( $ok, $desc );
$Test->diag( $error ) if $error;
return $ok;
@@ -287,18 +315,22 @@
=head1 METHODS: CONTENT CHECKING
-=head2 html_lint_ok( [$msg] )
+=head2 $mech->html_lint_ok( [$msg] )
Checks the validity of the HTML on the current page. If the page is not
-HTML, then it fails.
-
-The URI is automatically appended to the I<$msg>.
+HTML, then it fails. The URI is automatically appended to the I<$msg>.
+
+Note that HTML::Lint must be installed for this to work. Otherwise,
+it will blow up.
=cut
sub html_lint_ok {
my $self = shift;
my $msg = shift;
+
+ eval 'require HTML::Lint';
+ $@ and die 'html_lint_ok cannot run without HTML::Lint';
my $uri = $self->uri;
$msg = $msg ? "$msg ($uri)" : $uri;
@@ -306,16 +338,18 @@
my $ok;
if ( $self->is_html ) {
- require HTML::Lint;
my $lint = HTML::Lint->new;
- $lint->newfile( $uri );
$lint->parse( $self->content );
my @errors = $lint->errors;
- if ( @errors ) {
+ my $nerrors = @errors;
+ if ( $nerrors ) {
$ok = $Test->ok( 0, $msg );
+ $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 );
@@ -342,6 +376,7 @@
my $self = shift;
my $str = shift;
my $desc = shift;
+ $desc = "Title is '$str'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is_string( $self->title, $str, $desc );
@@ -359,6 +394,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Title is like '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return like_string( $self->title, $regex, $desc );
@@ -376,6 +412,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Title unlike '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return unlike_string( $self->title, $regex, $desc );
@@ -393,6 +430,7 @@
my $self = shift;
my $str = shift;
my $desc = shift;
+ $desc = "Base is '$str'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is_string( $self->base, $str, $desc );
@@ -410,6 +448,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Base is like '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return like_string( $self->base, $regex, $desc );
@@ -427,6 +466,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Base unlike '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return unlike_string( $self->base, $regex, $desc );
@@ -444,6 +484,8 @@
my $desc = shift;
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ $desc = qq{Content is "$str"} if !defined($desc);
+
return is_string( $self->content, $str, $desc );
}
@@ -459,6 +501,11 @@
my $desc = shift;
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ if ( ref($str) eq 'REGEX' ) {
+ diag( "content_contains takes a string, not a regex" );
+ }
+ $desc = qq{Content contains "$str"} if !defined($desc);
+
return contains_string( $self->content, $str, $desc );
}
@@ -474,6 +521,11 @@
my $desc = shift;
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ if ( ref($str) eq 'REGEX' ) {
+ diag( 'content_lacks takes a string, not a regex' );
+ }
+ $desc = qq{Content lacks "$str"} if !defined($desc);
+
return lacks_string( $self->content, $str, $desc );
}
@@ -487,6 +539,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Content is like '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return like_string( $self->content, $regex, $desc );
@@ -502,6 +555,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Content unlike '$regex'" if !defined($desc);
local $Test::Builder::Level = $Test::Builder::Level + 1;
return unlike_string( $self->content, $regex, $desc );
@@ -518,6 +572,7 @@
my $tag = shift;
my $text = shift;
my $desc = shift;
+ $desc = "Page has $tag tag with '$text'" if !defined($desc);
my $found = $self->_tag_walk( $tag, sub { $text eq $_[0] } );
@@ -536,6 +591,7 @@
my $tag = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "Page has $tag tag like '$regex'" if !defined($desc);
my $found = $self->_tag_walk( $tag, sub { $_[0] =~ $regex } );
@@ -581,6 +637,7 @@
sub page_links_ok {
my $self = shift;
my $desc = shift;
+ $desc = "All links ok" if !defined($desc);
my @links = $self->followable_links();
my @urls = _format_links(\@links);
@@ -607,6 +664,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "All links are like '$regex'" if !defined($desc);
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
@@ -641,6 +699,7 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
+ $desc = "All links are unlike '$regex'" if !defined($desc);
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
@@ -684,6 +743,7 @@
my $desc = shift;
my @urls = _format_links( $links );
+ $desc = _default_links_desc(\@urls, "are ok") if !defined($desc);
my @failures = $self->_check_links_status( \@urls );
my $ok = (@failures == 0);
@@ -713,6 +773,7 @@
my $desc = shift;
my @urls = _format_links( $links );
+ $desc = _default_links_desc(\@urls, "have status $status") if !defined($desc);
my @failures = $self->_check_links_status( \@urls, $status );
my $ok = (@failures == 0);
@@ -742,6 +803,7 @@
my $desc = shift;
my @urls = _format_links( $links );
+ $desc = _default_links_desc(\@urls, "do not have status $status") if !defined($desc);
my @failures = $self->_check_links_status( \@urls, $status, 'isnt' );
my $ok = (@failures == 0);
@@ -779,6 +841,7 @@
}
my @urls = _format_links( $links );
+ $desc = _default_links_desc(\@urls, "are like '$regex'") if !defined($desc);
my @failures = $self->_check_links_content( \@urls, $regex );
my $ok = (@failures == 0);
@@ -815,6 +878,7 @@
}
my @urls = _format_links( $links );
+ $desc = _default_links_desc(\@urls, "are not like '$regex'") if !defined($desc);
my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
my $ok = (@failures == 0);
@@ -822,6 +886,13 @@
$Test->diag( $_ ) for @failures;
return $ok;
+}
+
+# Create a default description for the link_* methods, including the link count.
+sub _default_links_desc {
+ my ($urls, $desc_suffix) = @_;
+ my $url_count = scalar(@$urls);
+ return sprintf("%d link%s %s", $url_count, $url_count == 1 ? "" : "s", $desc_suffix);
}
# This actually performs the status check of each url.
@@ -1075,8 +1146,8 @@
L<http://code.google.com/p/www-mechanize/issues/list>
-Please note that WWW::Mechanize and Test::WWW::Mechanize do NOT use
-rt.cpan.org at
+Please B<do not use> the old queues for WWW::Mechanize and
+Test::WWW::Mechanize at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-WWW-Mechanize>
=item * AnnoCPAN: Annotated CPAN documentation
Modified: trunk/libtest-www-mechanize-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/debian/changelog?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/debian/changelog (original)
+++ trunk/libtest-www-mechanize-perl/debian/changelog Wed Dec 19 14:45:50 2007
@@ -1,3 +1,9 @@
+libtest-www-mechanize-perl (1.18-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- David Paleino <d.paleino at gmail.com> Wed, 19 Dec 2007 16:45:32 +0100
+
libtest-www-mechanize-perl (1.16-1) unstable; urgency=low
* New upstream release
Modified: trunk/libtest-www-mechanize-perl/t/content_contains.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/content_contains.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/content_contains.t (original)
+++ trunk/libtest-www-mechanize-perl/t/content_contains.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 6;
use Test::Builder::Tester;
use URI::file;
@@ -16,6 +16,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -30,6 +31,10 @@
$mech->content_contains( 'Test Page', "Does it say test page?" );
test_test( "Finds the contains" );
+# default desc
+test_out( 'ok 1 - Content contains "Test Page"' );
+$mech->content_contains( 'Test Page');
+test_test( "Finds the contains - default desc" );
test_out( 'not ok 1 - Where is Mungo?' );
test_fail(+3);
Modified: trunk/libtest-www-mechanize-perl/t/content_lacks.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/content_lacks.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/content_lacks.t (original)
+++ trunk/libtest-www-mechanize-perl/t/content_lacks.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 6;
use Test::Builder::Tester;
use URI::file;
@@ -16,6 +16,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -30,6 +31,10 @@
$mech->content_lacks( 'Mungo eats cheese', "Does it say Mungo eats cheese?" );
test_test( "Finds the lacks" );
+# default desc
+test_out( 'ok 1 - Content lacks "Mungo eats cheese"' );
+$mech->content_lacks( 'Mungo eats cheese');
+test_test( "Finds the lacks - default desc" );
test_out( "not ok 1 - Shouldn't say it's a test page" );
test_fail(+4);
Modified: trunk/libtest-www-mechanize-perl/t/follow_link_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/follow_link_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/follow_link_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/follow_link_ok.t Wed Dec 19 14:45:50 2007
@@ -13,10 +13,10 @@
use_ok( 'Test::WWW::Mechanize' );
}
-
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -29,10 +29,9 @@
$mech->follow_link_ok( {n=>1}, "Go after first link" );
}
-#FOLLOW_BAD_LINK: {
-my $mech = Test::WWW::Mechanize->new();
-isa_ok( $mech,'Test::WWW::Mechanize' );
-TODO: {
+FOLLOW_BAD_LINK: {
+ my $mech = Test::WWW::Mechanize->new();
+ isa_ok( $mech, 'Test::WWW::Mechanize' );
local $TODO = "I don't know how to get Test::Builder::Tester to handle regexes for the timestamp.";
$mech->get('http://localhost:'.PORT.'/badlinks.html');
Modified: trunk/libtest-www-mechanize-perl/t/followable_links.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/followable_links.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/followable_links.t (original)
+++ trunk/libtest-www-mechanize-perl/t/followable_links.t Wed Dec 19 14:45:50 2007
@@ -18,6 +18,9 @@
my $server = TWMServer->new(PORT);
my $pid = $server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+
+# HTTP::Server::Simple->background() can return prematurely, so give it time to fire up
+sleep 1;
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
Modified: trunk/libtest-www-mechanize-perl/t/get_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/get_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/get_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/get_ok.t Wed Dec 19 14:45:50 2007
@@ -17,7 +17,7 @@
BEGIN {
$ENV{http_proxy} = ''; # All our tests are running on localhost
- plan tests => 11;
+ plan tests => 12;
use_ok( 'Test::WWW::Mechanize' );
}
@@ -25,6 +25,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok( $pid,'HTTP Server started' ) or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -43,6 +44,11 @@
test_test('Gets existing URI and reports success');
is( ref($ok), '', "get_ok() should only return a scalar" );
ok( $ok, "And the result should be true" );
+
+ # default desc
+ test_out("ok 1 - GET $goodlinks");
+ $mech->get_ok($goodlinks);
+ test_test('Gets existing URI and reports success - default desc');
}
BAD_GET: {
Modified: trunk/libtest-www-mechanize-perl/t/has_tag.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/has_tag.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/has_tag.t (original)
+++ trunk/libtest-www-mechanize-perl/t/has_tag.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 7;
+use Test::More tests => 8;
use Test::Builder::Tester;
use URI::file;
@@ -17,6 +17,8 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+# $server->background() may come back prematurely, so give it a second to fire up
+sleep 1;
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -29,6 +31,11 @@
test_out( 'ok 1 - looking for "Test" link' );
$mech->has_tag( h1 => 'Test Page', 'looking for "Test" link' );
test_test( 'Handles finding tag by content' );
+
+# default desc
+test_out( 'ok 1 - Page has h1 tag with \'Test Page\'' );
+$mech->has_tag( h1 => 'Test Page' );
+test_test( 'Handles finding tag by content - default desc' );
test_out( 'not ok 1 - looking for "Quiz" link' );
test_fail( +1 );
Modified: trunk/libtest-www-mechanize-perl/t/html_lint_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/html_lint_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/html_lint_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/html_lint_ok.t Wed Dec 19 14:45:50 2007
@@ -2,8 +2,14 @@
use strict;
use warnings;
-use Test::Builder::Tester tests => 4;
+use Test::Builder::Tester;
use Test::More;
+
+BEGIN {
+ eval 'use HTML::Lint';
+ plan skip_all => 'HTML::Lint is not installed, cannot test html_lint_ok' if $@;
+ plan tests => 4;
+}
use URI::file;
@@ -19,10 +25,12 @@
$mech->get_ok( $uri, 'Fetching the file from disk' );
test_out( "not ok 1 - checking HTML ($uri)" );
- test_fail( +4 );
- test_err( qq{# $uri (7:9) Unknown attribute "hrex" for tag <a>} );
- test_err( qq{# $uri (8:33) </b> with no opening <b>} );
- test_err( qq{# $uri (9:5) <a> at (8:9) is never closed} );
+ 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->html_lint_ok( 'checking HTML' );
test_test( 'Proper html_lint_ok results' );
}
Modified: trunk/libtest-www-mechanize-perl/t/link_content.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/link_content.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/link_content.t (original)
+++ trunk/libtest-www-mechanize-perl/t/link_content.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More tests => 12;
use Test::Builder::Tester;
use URI::file;
@@ -17,6 +17,8 @@
my $server = TWMServer->new(PORT);
my $pid = $server->background;
ok( $pid, 'HTTP Server started' ) or die "Can't start the server";
+# HTTP::Server::Simple->background() may return prematurely.
+sleep 1;
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -24,8 +26,6 @@
my $mech=Test::WWW::Mechanize->new();
isa_ok($mech,'Test::WWW::Mechanize');
-# HTTP::Server::Simple->background() may return prematurely.
-sleep 1;
$mech->get('http://localhost:'.PORT.'/goodlinks.html');
my @urls=$mech->links();
ok(@urls, 'Got links from the HTTP server');
@@ -41,6 +41,11 @@
test_out('ok 1 - Checking all page links contain: Test');
$mech->link_content_like(\@urls,qr/Test/,'Checking all page links contain: Test');
test_test('Handles All page links contents successful');
+
+# like - default desc
+test_out('ok 1 - ' . scalar(@urls) . ' links are like \'(?-xism:Test)\'');
+$mech->link_content_like(\@urls,qr/Test/);
+test_test('Handles All page links contents successful - default desc');
test_out('not ok 1 - Checking all page link content failures');
test_fail(+4);
@@ -61,6 +66,11 @@
test_out('ok 1 - Checking all page links do not contain: BadTest');
$mech->link_content_unlike(\@urls,qr/BadTest/,'Checking all page links do not contain: BadTest');
test_test('Handles All page links unlike contents successful');
+
+# unlike - default desc
+test_out('ok 1 - ' . scalar(@urls) . ' links are not like \'(?-xism:BadTest)\'');
+$mech->link_content_unlike(\@urls,qr/BadTest/);
+test_test('Handles All page links unlike contents successful - default desc');
test_out('not ok 1 - Checking all page link unlike content failures');
test_fail(+4);
Modified: trunk/libtest-www-mechanize-perl/t/link_status.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/link_status.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/link_status.t (original)
+++ trunk/libtest-www-mechanize-perl/t/link_status.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 9;
use Test::Builder::Tester;
use URI::file;
@@ -17,6 +17,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -31,6 +32,11 @@
test_out('ok 1 - Checking all links status are 200');
$mech->link_status_is($links,200,'Checking all links status are 200');
test_test('Handles All Links successful');
+
+# Good links - Default desc
+test_out('ok 1 - ' . scalar(@$links) . ' links have status 200');
+$mech->link_status_is($links,200);
+test_test('Handles All Links successful - default desc');
$mech->link_status_isnt($links,404,'Checking all links isnt');
Modified: trunk/libtest-www-mechanize-perl/t/links_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/links_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/links_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/links_ok.t Wed Dec 19 14:45:50 2007
@@ -17,6 +17,8 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+# HTTP::Server::Simple->background() can return prematurely, so give it time to fire up
+sleep 1;
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
Modified: trunk/libtest-www-mechanize-perl/t/page_links_content.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/page_links_content.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/page_links_content.t (original)
+++ trunk/libtest-www-mechanize-perl/t/page_links_content.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 10;
use Test::Builder::Tester;
use URI::file;
@@ -17,6 +17,9 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+# HTTP::Server::Simple->background() can return prematurely, so give it time to fire up
+sleep 1;
+
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -36,6 +39,11 @@
# like
test_out('ok 1 - Checking all page links contain: Test');
$mech->page_links_content_like(qr/Test/,'Checking all page links contain: Test');
+test_test('Handles All page links contents successful');
+
+# like - default desc
+test_out('ok 1 - All links are like \'(?-xism:Test)\'');
+$mech->page_links_content_like(qr/Test/);
test_test('Handles All page links contents successful');
test_out('not ok 1 - Checking all page link content failures');
Modified: trunk/libtest-www-mechanize-perl/t/page_links_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/page_links_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/page_links_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/page_links_ok.t Wed Dec 19 14:45:50 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 6;
use Test::Builder::Tester;
use URI::file;
@@ -17,6 +17,8 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+# Pause a second in case $server->background() came back too fast
+sleep 1;
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
@@ -31,6 +33,11 @@
test_out('ok 1 - Checking all page links successful');
$mech->page_links_ok('Checking all page links successful');
test_test('Handles All page links successful');
+
+# Good links - default desc
+test_out('ok 1 - All links ok');
+$mech->page_links_ok();
+test_test('Handles All page links successful - default desc');
# Bad links
$mech->get('http://localhost:'.PORT.'/badlinks.html');
Modified: trunk/libtest-www-mechanize-perl/t/stuff_inputs.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/stuff_inputs.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/stuff_inputs.t (original)
+++ trunk/libtest-www-mechanize-perl/t/stuff_inputs.t Wed Dec 19 14:45:50 2007
@@ -17,6 +17,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
Modified: trunk/libtest-www-mechanize-perl/t/submit_form_ok.t
URL: http://svn.debian.org/wsvn/trunk/libtest-www-mechanize-perl/t/submit_form_ok.t?rev=11428&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/submit_form_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/submit_form_ok.t Wed Dec 19 14:45:50 2007
@@ -16,6 +16,7 @@
my $server=TWMServer->new(PORT);
my $pid=$server->background;
ok($pid,'HTTP Server started') or die "Can't start the server";
+sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
sub cleanup { kill(9,$pid) };
$SIG{__DIE__}=\&cleanup;
More information about the Pkg-perl-cvs-commits
mailing list