[Jifty-commit] r3783 - in Test-WWW-Declare: lib/Test/WWW t
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Fri Aug 3 17:55:12 EDT 2007
Author: sartak
Date: Fri Aug 3 17:55:12 2007
New Revision: 3783
Added:
Test-WWW-Declare/t/06-title.t
Modified:
Test-WWW-Declare/ (props changed)
Test-WWW-Declare/lib/Test/WWW/Declare.pm
Log:
r29886 at caladan: sartak | 2007-08-03 17:55:05 -0400
Add some more magic! `title should caselessly equal 'InDeX'` now works
Modified: Test-WWW-Declare/lib/Test/WWW/Declare.pm
==============================================================================
--- Test-WWW-Declare/lib/Test/WWW/Declare.pm (original)
+++ Test-WWW-Declare/lib/Test/WWW/Declare.pm Fri Aug 3 17:55:12 2007
@@ -8,7 +8,8 @@
our $VERSION = '0.00';
our @EXPORT = qw(flow run get session check mech match follow link content
- should shouldnt click href button fill form SKIP _twd_dummy);
+ should shouldnt click href button fill form SKIP _twd_dummy
+ title equal caselessly);
our $BUILDER = Test::Builder->new();
our $WWW_MECHANIZE;
@@ -30,15 +31,23 @@
# DSLey functions
sub should ($) {
- return [shift, 1];
+ return {positive => 1, %{shift @_}};
}
sub shouldnt ($) {
- return [shift, 0];
+ return {positive => 0, %{shift @_}};
}
sub match ($) {
- return shift;
+ return {match => 'regex', expected => shift};
+}
+
+sub equal ($) {
+ return {match => 'equality', expected => shift};
+}
+
+sub caselessly ($) {
+ return {case_insensitive => 1, %{shift @_}};
}
sub check (&) {
@@ -99,15 +108,58 @@
}
sub content ($) {
- my $regex_wrapped = shift;
- my ($regex, $positive) = @$regex_wrapped;
+ _magic_match({got => mech()->content, name => "Content", %{shift @_}});
+}
+
+sub title ($) {
+ my $title = mech()->title;
+ _magic_match({got => $title, name => "Title '$title'", %{shift @_}});
+}
+
+# yes, there's a little too much logic in here. that's why it's magic
+sub _magic_match {
+ my $orig = shift @_;
+ my %args = %$orig;
+ my $match;
+ my @output;
+
+ push @output, $args{name};
+ push @output, $args{positive} ? "does not"
+ : "";
+
+ if ($args{match} eq 'equality') {
+ if ($args{case_insensitive}) {
+ push @output, "caselessly";
+ $args{got} = lc $args{got};
+ $args{expected} = lc $args{expected};
+ }
- my $failure = 1;
+ push @output, $args{positive} ? "equal"
+ : "equals";
+ push @output, $orig->{expected};
- $failure = 0 if $positive && mech()->content =~ $regex;
- $failure = 0 if !$positive && mech()->content !~ $regex;
- Carp::croak "Content did not match $regex" if $failure;
+ $match = $args{got} eq $args{expected};
+ }
+ elsif ($args{match} eq 'regex') {
+ if ($args{case_insensitive}) {
+ push @output, "caselessly";
+ push @output, $args{expected};
+ $args{expected} = "(?i:$args{expected})";
+ }
+
+ push @output, $args{positive} ? "match"
+ : "matches";
+ push @output, $orig->{expected};
+
+ $match = $args{got} =~ $args{expected};
+ }
+ else {
+ Carp::croak "No \$args{match} (yes this error needs to be fixed)";
+ }
+
+ return 1 if ($match ? 0 : 1) ^ $args{positive};
+ Carp::croak join(' ', @output);
}
sub form ($$) {
Added: Test-WWW-Declare/t/06-title.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/06-title.t Fri Aug 3 17:55:12 2007
@@ -0,0 +1,29 @@
+#!perl
+use Test::WWW::Declare::Tester tests => 5;
+use warnings;
+use strict;
+
+my @results = run_tests(
+ sub {
+ session "check logins" => run {
+ flow "basic connectivity" => check {
+ get "http://localhost:$PORT/";
+ title should match qr{in.ex}i;
+ click href qr{good};
+ title should equal 'GOOD';
+ click href qr{index};
+ title should caselessly equal 'InDeX';
+ };
+ };
+ }
+);
+
+shift @results; # Test::Tester gives 1-based arrays
+is(@results, 2, "had two tests");
+ok($results[0]{ok}, "1st test passed");
+ok($results[1]{ok}, "2nd test passed");
+
+is($results[0]{name}, "basic connectivity", "1st test was flow");
+is($results[1]{name}, "check logins", "2nd test was session");
+
+
More information about the Jifty-commit
mailing list