r17686 - in /trunk/libtest-www-mechanize-perl: ./ debian/ t/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Mon Mar 17 01:23:00 UTC 2008
Author: gregoa-guest
Date: Mon Mar 17 01:22:59 2008
New Revision: 17686
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=17686
Log:
New upstream release.
Added:
trunk/libtest-www-mechanize-perl/t/._stuff_inputs.html (with props)
trunk/libtest-www-mechanize-perl/t/._stuff_inputs.t (with props)
trunk/libtest-www-mechanize-perl/t/stuff_inputs.html
Modified:
trunk/libtest-www-mechanize-perl/Changes
trunk/libtest-www-mechanize-perl/MANIFEST
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/00load.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-parms.t
trunk/libtest-www-mechanize-perl/t/get_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/pod-coverage.t
trunk/libtest-www-mechanize-perl/t/pod.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/pkg-perl/trunk/libtest-www-mechanize-perl/Changes?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Changes (original)
+++ trunk/libtest-www-mechanize-perl/Changes Mon Mar 17 01:22:59 2008
@@ -3,6 +3,16 @@
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.20 Wed Mar 12 23:56:11 CDT 2008
+-----------------------------------
+[FIXES]
+stuff_inputs() used to do nothing. Now it works.
+http://code.google.com/p/www-mechanize/issues/detail?id=9
+
+Fixed punctuation in some error messages.
+
+Fixed compatibility with WWW::Mechanize 1.36.
1.18 Thu Dec 6 10:12:14 CST 2007
Modified: trunk/libtest-www-mechanize-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/MANIFEST?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/MANIFEST (original)
+++ trunk/libtest-www-mechanize-perl/MANIFEST Mon Mar 17 01:22:59 2008
@@ -22,6 +22,7 @@
t/page_links_ok.t
t/pod-coverage.t
t/pod.t
+t/stuff_inputs.html
t/stuff_inputs.t
t/submit_form_ok.t
Modified: trunk/libtest-www-mechanize-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/META.yml?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/META.yml (original)
+++ trunk/libtest-www-mechanize-perl/META.yml Mon Mar 17 01:22:59 2008
@@ -1,10 +1,11 @@
-# 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.18
-version_from: Mechanize.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Test-WWW-Mechanize
+version: 1.20
+abstract: Testing-specific WWW::Mechanize subclass
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.36
+distribution_type: module
+requires:
Carp::Assert::More: 0
HTTP::Server::Simple: 0.07
Test::Builder::Tester: 1.09
@@ -12,6 +13,11 @@
Test::More: 0
URI::file: 0
WWW::Mechanize: 1.24
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Andy Lester <andy at petdance.com>
+resources:
+ homepage: http://code.google.com/p/www-mechanize/
+ bugtracker: http://code.google.com/p/www-mechanize/issues/list
Modified: trunk/libtest-www-mechanize-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/Makefile.PL?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Makefile.PL (original)
+++ trunk/libtest-www-mechanize-perl/Makefile.PL Mon Mar 17 01:22:59 2008
@@ -37,7 +37,7 @@
.PHONY: critic tags
critic:
- perlcritic -1 -q -profile perlcriticrc bin/ lib/ t/
+ perlcritic -1 -q -profile perlcriticrc Mechanize.pm t/
tags:
ctags -f tags --recurse --totals \
Modified: trunk/libtest-www-mechanize-perl/Mechanize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/Mechanize.pm?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/Mechanize.pm (original)
+++ trunk/libtest-www-mechanize-perl/Mechanize.pm Mon Mar 17 01:22:59 2008
@@ -1,5 +1,8 @@
package Test::WWW::Mechanize;
+use strict;
+use warnings;
+
=head1 NAME
Test::WWW::Mechanize - Testing-specific WWW::Mechanize subclass
@@ -10,7 +13,7 @@
=cut
-our $VERSION = '1.18';
+our $VERSION = '1.20';
=head1 SYNOPSIS
@@ -61,9 +64,6 @@
=cut
-use warnings;
-use strict;
-
use WWW::Mechanize ();
use Test::LongString;
use Test::Builder ();
@@ -120,11 +120,11 @@
$desc = shift;
}
elsif ( ref $flex eq 'HASH' ) {
- %opts = %$flex;
+ %opts = %{$flex};
$desc = shift;
}
elsif ( ref $flex eq 'ARRAY' ) {
- %opts = @$flex;
+ %opts = @{$flex};
$desc = shift;
}
else {
@@ -173,11 +173,11 @@
$desc = shift;
}
elsif ( ref $flex eq 'HASH' ) {
- %opts = %$flex;
+ %opts = %{$flex};
$desc = shift;
}
elsif ( ref $flex eq 'ARRAY' ) {
- %opts = @$flex;
+ %opts = @{$flex};
$desc = shift;
}
else {
@@ -232,7 +232,7 @@
}
# return from submit_form() is an HTTP::Response or undef
- my $response = $self->submit_form( %$parms );
+ my $response = $self->submit_form( %{$parms} );
my $ok;
my $error;
@@ -282,7 +282,7 @@
my $desc = shift;
if (!defined($desc)) {
- my $parms_str = join(", ", map { join("=", $_, $parms->{$_}) } keys(%$parms));
+ my $parms_str = join(", ", map { join("=", $_, $parms->{$_}) } keys(%{$parms}));
$desc = "Followed link with '$parms_str'" if !defined($desc);
}
@@ -291,7 +291,7 @@
}
# return from follow_link() is an HTTP::Response or undef
- my $response = $self->follow_link( %$parms );
+ my $response = $self->follow_link( %{$parms} );
my $ok;
my $error;
@@ -637,7 +637,8 @@
sub page_links_ok {
my $self = shift;
my $desc = shift;
- $desc = "All links ok" if !defined($desc);
+
+ $desc = 'All links ok' unless defined $desc;
my @links = $self->followable_links();
my @urls = _format_links(\@links);
@@ -664,12 +665,13 @@
my $self = shift;
my $regex = shift;
my $desc = shift;
- $desc = "All links are like '$regex'" if !defined($desc);
+
+ $desc = qq{All links are like "$regex"} unless defined $desc;
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
my $ok = $Test->ok( 0, 'page_links_content_like' );
- $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ $Test->diag(qq{ "$regex" doesn't look much like a regex to me.});
return $ok;
}
@@ -704,7 +706,7 @@
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
my $ok = $Test->ok( 0, 'page_links_content_unlike' );
- $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ $Test->diag(qq{ "$regex" doesn't look much like a regex to me.});
return $ok;
}
@@ -743,7 +745,7 @@
my $desc = shift;
my @urls = _format_links( $links );
- $desc = _default_links_desc(\@urls, "are ok") if !defined($desc);
+ $desc = _default_links_desc(\@urls, 'are ok') unless defined $desc;
my @failures = $self->_check_links_status( \@urls );
my $ok = (@failures == 0);
@@ -836,7 +838,7 @@
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
my $ok = $Test->ok( 0, 'link_content_like' );
- $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ $Test->diag(qq{ "$regex" doesn't look much like a regex to me.});
return $ok;
}
@@ -873,12 +875,12 @@
my $usable_regex=$Test->maybe_regex( $regex );
unless(defined( $usable_regex )) {
my $ok = $Test->ok( 0, 'link_content_unlike' );
- $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ $Test->diag(qq{ "$regex" doesn't look much like a regex to me.});
return $ok;
}
my @urls = _format_links( $links );
- $desc = _default_links_desc(\@urls, "are not like '$regex'") if !defined($desc);
+ $desc = _default_links_desc(\@urls, qq{are not like "$regex"}) if !defined($desc);
my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
my $ok = (@failures == 0);
@@ -962,13 +964,13 @@
my $links = shift;
my @urls;
- if(ref($links) eq 'ARRAY') {
- if(defined($$links[0])) {
- if(ref($$links[0]) eq 'WWW::Mechanize::Link') {
- @urls=map { $_->url() } @$links;
+ if (ref($links) eq 'ARRAY') {
+ if (defined($$links[0])) {
+ if (ref($$links[0]) eq 'WWW::Mechanize::Link') {
+ @urls = map { $_->url() } @{$links};
}
else {
- @urls=@$links;
+ @urls = @{$links};
}
}
}
@@ -1038,7 +1040,7 @@
my $options = shift || {};
assert_isa( $options, 'HASH' );
- assert_in( $_, ['ignore', 'fill', 'specs'] ) foreach ( keys %$options );
+ assert_in( $_, ['ignore', 'fill', 'specs'] ) foreach ( keys %{$options} );
# set up the fill we'll use unless a field overrides it
my $default_fill = '@';
@@ -1057,13 +1059,13 @@
if ( exists $options->{specs} ) {
assert_isa( $options->{specs}, 'HASH' );
$specs = $options->{specs};
- foreach my $field_name ( keys %$specs ) {
+ foreach my $field_name ( keys %{$specs} ) {
assert_isa( $specs->{$field_name}, 'HASH' );
assert_in( $_, ['fill', 'maxlength'] ) foreach ( keys %{$specs->{$field_name}} );
}
}
- my @inputs = $self->find_all_inputs( type => qr/^(text|textarea|password)$/ );
+ my @inputs = $self->find_all_inputs( type_regex => qr/^(text|textarea|password)$/ );
foreach my $field ( @inputs ) {
next if $field->readonly();
Modified: trunk/libtest-www-mechanize-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/debian/changelog?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/debian/changelog (original)
+++ trunk/libtest-www-mechanize-perl/debian/changelog Mon Mar 17 01:22:59 2008
@@ -1,3 +1,9 @@
+libtest-www-mechanize-perl (1.20-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Mon, 17 Mar 2008 02:22:32 +0100
+
libtest-www-mechanize-perl (1.18-2) unstable; urgency=low
[ gregor herrmann ]
Added: trunk/libtest-www-mechanize-perl/t/._stuff_inputs.html
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/._stuff_inputs.html?rev=17686&op=file
==============================================================================
Binary file - no diff available.
Propchange: trunk/libtest-www-mechanize-perl/t/._stuff_inputs.html
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: trunk/libtest-www-mechanize-perl/t/._stuff_inputs.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/._stuff_inputs.t?rev=17686&op=file
==============================================================================
Binary file - no diff available.
Propchange: trunk/libtest-www-mechanize-perl/t/._stuff_inputs.t
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Modified: trunk/libtest-www-mechanize-perl/t/00load.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/00load.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/00load.t (original)
+++ trunk/libtest-www-mechanize-perl/t/00load.t Mon Mar 17 01:22:59 2008
@@ -1,4 +1,7 @@
#!perl
+
+use warnings;
+use strict;
use Test::More tests => 1;
Modified: trunk/libtest-www-mechanize-perl/t/follow_link_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/follow_link_ok.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/follow_link_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/follow_link_ok.t Mon Mar 17 01:22:59 2008
@@ -22,15 +22,15 @@
$SIG{__DIE__}=\&cleanup;
FOLLOW_GOOD_LINK: {
- my $mech = Test::WWW::Mechanize->new();
+ my $mech = Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok( $mech,'Test::WWW::Mechanize' );
$mech->get('http://localhost:'.PORT.'/goodlinks.html');
- $mech->follow_link_ok( {n=>1}, "Go after first link" );
+ $mech->follow_link_ok( {n=>1}, 'Go after first link' );
}
FOLLOW_BAD_LINK: {
- my $mech = Test::WWW::Mechanize->new();
+ my $mech = Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok( $mech, 'Test::WWW::Mechanize' );
local $TODO = "I don't know how to get Test::Builder::Tester to handle regexes for the timestamp.";
Modified: trunk/libtest-www-mechanize-perl/t/followable_links.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/followable_links.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/followable_links.t (original)
+++ trunk/libtest-www-mechanize-perl/t/followable_links.t Mon Mar 17 01:22:59 2008
@@ -17,7 +17,7 @@
my $server = TWMServer->new(PORT);
my $pid = $server->background;
-ok($pid,'HTTP Server started') or die "Can't start the server";
+ok($pid,'HTTP Server started') or die q{Can't start the server};
# HTTP::Server::Simple->background() can return prematurely, so give it time to fire up
sleep 1;
@@ -40,7 +40,7 @@
"$base/badlinks.html",
"$base/goodlinks.html",
);
-is_deeply( \@links, \@expected, "Got the right links" );
+is_deeply( \@links, \@expected, 'Got the right links' );
cleanup();
Modified: trunk/libtest-www-mechanize-perl/t/get_ok-parms.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/get_ok-parms.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/get_ok-parms.t (original)
+++ trunk/libtest-www-mechanize-perl/t/get_ok-parms.t Mon Mar 17 01:22:59 2008
@@ -24,7 +24,7 @@
my $mech = Test::WWW::Mechanize->new();
isa_ok( $mech, 'Test::WWW::Mechanize' );
-my $url = "dummy://url";
+my $url = 'dummy://url';
$mech->get_ok( $url );
ok( eq_hash( {}, $ua_args ), 'passing URL only' );
@@ -36,14 +36,14 @@
my $wanted = { foo=>1, bar=>2, baz=>3 };
-$mech->get_ok( $url, [ %$wanted ] );
+$mech->get_ok( $url, [ %{$wanted} ] );
ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous list for hash' );
-$mech->get_ok( $url, [ %$wanted ], 'Description' );
+$mech->get_ok( $url, [ %{$wanted} ], 'Description' );
ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous list for hash' );
-$mech->get_ok( $url, { %$wanted } );
+$mech->get_ok( $url, { %{$wanted} } );
ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous array for hash' );
-$mech->get_ok( $url, { %$wanted }, 'Description' );
+$mech->get_ok( $url, { %{$wanted} }, 'Description' );
ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous array for hash' );
Modified: trunk/libtest-www-mechanize-perl/t/get_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/get_ok.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/get_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/get_ok.t Mon Mar 17 01:22:59 2008
@@ -30,7 +30,7 @@
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
-my $mech=Test::WWW::Mechanize->new();
+my $mech=Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok($mech,'Test::WWW::Mechanize');
GOOD_GET: {
Modified: trunk/libtest-www-mechanize-perl/t/link_content.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/link_content.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/link_content.t (original)
+++ trunk/libtest-www-mechanize-perl/t/link_content.t Mon Mar 17 01:22:59 2008
@@ -33,7 +33,7 @@
# test regex
test_out('not ok 1 - link_content_like');
test_fail(+2);
-test_diag(" 'blah' doesn't look much like a regex to me.");
+test_diag(q{ "blah" doesn't look much like a regex to me.});
$mech->link_content_like(\@urls,'blah','Testing the regex');
test_test('Handles bad regexs');
@@ -57,9 +57,9 @@
# unlike
# test regex
-test_out('not ok 1 - link_content_unlike');
+test_out('not ok 1 - link_content_unlike');
test_fail(+2);
-test_diag(" 'blah' doesn't look much like a regex to me.");
+test_diag(q{ "blah" doesn't look much like a regex to me.});
$mech->link_content_unlike(\@urls,'blah','Testing the regex');
test_test('Handles bad regexs');
@@ -68,7 +68,7 @@
test_test('Handles All page links unlike contents successful');
# unlike - default desc
-test_out('ok 1 - ' . scalar(@urls) . ' links are not like \'(?-xism:BadTest)\'');
+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');
Modified: trunk/libtest-www-mechanize-perl/t/link_status.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/link_status.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/link_status.t (original)
+++ trunk/libtest-www-mechanize-perl/t/link_status.t Mon Mar 17 01:22:59 2008
@@ -22,7 +22,7 @@
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
-my $mech=Test::WWW::Mechanize->new();
+my $mech=Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok($mech,'Test::WWW::Mechanize');
$mech->get('http://localhost:'.PORT.'/goodlinks.html');
Modified: trunk/libtest-www-mechanize-perl/t/links_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/links_ok.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/links_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/links_ok.t Mon Mar 17 01:22:59 2008
@@ -23,7 +23,7 @@
sub cleanup { kill(9,$pid) if !$^S };
$SIG{__DIE__}=\&cleanup;
-my $mech=Test::WWW::Mechanize->new();
+my $mech=Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok($mech,'Test::WWW::Mechanize');
$mech->get('http://localhost:'.PORT.'/goodlinks.html');
Modified: trunk/libtest-www-mechanize-perl/t/page_links_content.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/page_links_content.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/page_links_content.t (original)
+++ trunk/libtest-www-mechanize-perl/t/page_links_content.t Mon Mar 17 01:22:59 2008
@@ -32,7 +32,7 @@
# test regex
test_out('not ok 1 - page_links_content_like');
test_fail(+2);
-test_diag(" 'blah' doesn't look much like a regex to me.");
+test_diag(q{ "blah" doesn't look much like a regex to me.});
$mech->page_links_content_like('blah','Testing the regex');
test_test('Handles bad regexs');
@@ -42,7 +42,7 @@
test_test('Handles All page links contents successful');
# like - default desc
-test_out('ok 1 - All links are like \'(?-xism:Test)\'');
+test_out(q{ok 1 - All links are like "(?-xism:Test)"});
$mech->page_links_content_like(qr/Test/);
test_test('Handles All page links contents successful');
@@ -56,9 +56,9 @@
# unlike
# test regex
-test_out('not ok 1 - page_links_content_unlike');
+test_out('not ok 1 - page_links_content_unlike');
test_fail(+2);
-test_diag(" 'blah' doesn't look much like a regex to me.");
+test_diag(q{ "blah" doesn't look much like a regex to me.});
$mech->page_links_content_unlike('blah','Testing the regex');
test_test('Handles bad regexs');
Modified: trunk/libtest-www-mechanize-perl/t/page_links_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/page_links_ok.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/page_links_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/page_links_ok.t Mon Mar 17 01:22:59 2008
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 5;
use Test::Builder::Tester;
use URI::file;
@@ -15,15 +15,14 @@
}
my $server=TWMServer->new(PORT);
-my $pid=$server->background;
-ok($pid,'HTTP Server started') or die "Can't start the server";
+my $pid=$server->background or die q{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;
-my $mech=Test::WWW::Mechanize->new();
+my $mech=Test::WWW::Mechanize->new( autocheck => 0 );
isa_ok($mech,'Test::WWW::Mechanize');
Modified: trunk/libtest-www-mechanize-perl/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/pod-coverage.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/pod-coverage.t (original)
+++ trunk/libtest-www-mechanize-perl/t/pod-coverage.t Mon Mar 17 01:22:59 2008
@@ -1,6 +1,9 @@
#!perl
+use strict;
+use warnings;
+
use Test::More;
-eval "use Test::Pod::Coverage 0.08";
-plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@;
+eval 'use Test::Pod::Coverage 0.08';
+plan skip_all => 'Test::Pod::Coverage 0.08 required for testing POD coverage' if $@;
all_pod_coverage_ok();
Modified: trunk/libtest-www-mechanize-perl/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/pod.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/pod.t (original)
+++ trunk/libtest-www-mechanize-perl/t/pod.t Mon Mar 17 01:22:59 2008
@@ -3,6 +3,6 @@
use strict;
use warnings;
use Test::More;
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+eval 'use Test::Pod 1.00';
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
all_pod_files_ok();
Added: trunk/libtest-www-mechanize-perl/t/stuff_inputs.html
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/stuff_inputs.html?rev=17686&op=file
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/stuff_inputs.html (added)
+++ trunk/libtest-www-mechanize-perl/t/stuff_inputs.html Mon Mar 17 01:22:59 2008
@@ -1,0 +1,6 @@
+<html>
+<head><title>Title</title></head>
+<body>
+<form name="testform">
+</form>
+</body>
Modified: trunk/libtest-www-mechanize-perl/t/stuff_inputs.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/stuff_inputs.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/stuff_inputs.t (original)
+++ trunk/libtest-www-mechanize-perl/t/stuff_inputs.t Mon Mar 17 01:22:59 2008
@@ -1,56 +1,174 @@
-#!perl -w
+#!perl -Tw
use strict;
use warnings;
-use Test::More tests => 3;
-use Test::Builder::Tester;
+
+use Test::More tests => 44;
use URI::file;
-
-use constant PORT => 13432;
-
-$ENV{http_proxy} = ''; # All our tests are running on localhost
BEGIN {
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
+my $mech = Test::WWW::Mechanize->new();
+my $uri = URI::file->new_abs( 't/stuff_inputs.html' )->as_string;
-sub cleanup { kill(9,$pid) if !$^S };
-$SIG{__DIE__}=\&cleanup;
+EMPTY_FIELDS: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
-my $mech=Test::WWW::Mechanize->new();
-isa_ok( $mech, 'Test::WWW::Mechanize' );
-
-$mech->get('http://localhost:'.PORT.'/form.html');
-$mech->stuff_inputs();
+ add_test_fields( $mech );
+ $mech->stuff_inputs();
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => '@' x 10,
+ text70k => '@' x 70_000,
+ textunlimited => '@' x 66_000,
+ textarea => '@' x 66_000,
+ },
+ 'filling empty fields'
+ );
+}
-cleanup();
+MULTICHAR_FILL: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
-{
- package TWMServer;
- use base 'HTTP::Server::Simple::CGI';
+ add_test_fields( $mech );
+ $mech->stuff_inputs( { fill => '123' } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '1',
+ text10 => '1231231231',
+ text70k => ('123' x 23_333) . '1',
+ textunlimited => '123' x 22_000,
+ textarea => '123' x 22_000,
+ },
+ 'multichar_fill'
+ );
+}
- sub handle_request {
- my $self=shift;
- my $cgi=shift;
- my $file=(split('/',$cgi->path_info))[-1]||'index.html';
- $file=~s/\s+//g;
+OVERWRITE: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
- if(-r "t/html/$file") {
- if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
- print "HTTP/1.0 200 OK\r\n";
- print "Content-Type: text/html\r\nContent-Length: ",
- length($response), "\r\n\r\n", $response;
- return;
- }
+ add_test_fields( $mech );
+ $mech->stuff_inputs();
+ is( $mech->value('text10'), '@' x 10, 'overwriting fields: initial fill as expected' );
+ $mech->stuff_inputs( { fill => 'X' } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => 'X',
+ text10 => 'X' x 10,
+ text70k => 'X' x 70_000,
+ textunlimited => 'X' x 66_000,
+ textarea => 'X' x 66_000,
+ },
+ 'overwriting fields'
+ );
+}
+
+
+CUSTOM_FILL: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( {
+ fill => 'z',
+ specs => {
+ text10 => { fill=>'#' },
+ textarea => { fill=>'*' },
+ }
+ } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => 'z',
+ text10 => '#' x 10,
+ text70k => 'z' x 70_000,
+ textunlimited => 'z' x 66_000,
+ textarea => '*' x 66_000,
+ },
+ 'custom fill'
+ );
+}
+
+
+MAXLENGTH: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( {
+ specs => {
+ text10 => { maxlength=>7 },
+ textarea => { fill=>'*', maxlength=>9 },
+ }
+ }
+ );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => '@' x 7,
+ text70k => '@' x 70_000,
+ textunlimited => '@' x 66_000,
+ textarea => '*' x 9,
+ },
+ 'maxlength'
+ );
+}
+
+
+IGNORE: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( { ignore => [ 'text10' ] } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => undef,
+ text70k => '@' x 70_000,
+ textunlimited => '@' x 66_000,
+ textarea => '@' x 66_000,
+ },
+ 'ignore'
+ );
+}
+
+
+sub add_test_fields {
+ my $mech = shift;
+
+ HTML::Form::Input->new( type=>'text', name=>'text0', maxlength=>0 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text1', maxlength=>1 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text10', maxlength=>10 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text70k', maxlength=>70_000 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'textunlimited' )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'textarea', name=>'textarea' )->add_to_form( $mech->current_form() );
+
+ return;
+}
+
+
+sub field_checks {
+ my $mech = shift;
+ my $expected = shift;
+ my $desc = shift;
+
+ foreach my $key ( qw( text0 text1 text10 text70k textunlimited textarea ) ) {
+ is( $mech->value($key), $expected->{$key}, "$desc: field $key" );
}
- print "HTTP/1.0 404 Not Found\r\n\r\n";
- }
+ return;
}
Modified: trunk/libtest-www-mechanize-perl/t/submit_form_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-www-mechanize-perl/t/submit_form_ok.t?rev=17686&op=diff
==============================================================================
--- trunk/libtest-www-mechanize-perl/t/submit_form_ok.t (original)
+++ trunk/libtest-www-mechanize-perl/t/submit_form_ok.t Mon Mar 17 01:22:59 2008
@@ -14,8 +14,7 @@
my $server=TWMServer->new(PORT);
-my $pid=$server->background;
-ok($pid,'HTTP Server started') or die "Can't start the server";
+my $pid=$server->background or die q{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) };
@@ -26,7 +25,7 @@
isa_ok( $mech,'Test::WWW::Mechanize' );
$mech->get('http://localhost:'.PORT.'/form.html');
- $mech->submit_form_ok( {form_number =>1}, "Submit First Form" );
+ $mech->submit_form_ok( {form_number =>1}, 'Submit First Form' );
}
cleanup();
More information about the Pkg-perl-cvs-commits
mailing list