[Jifty-commit] r3779 - in Test-WWW-Declare: lib/Test/WWW/Declare t

jifty-commit at lists.jifty.org jifty-commit at lists.jifty.org
Fri Aug 3 17:21:51 EDT 2007


Author: sartak
Date: Fri Aug  3 17:21:51 2007
New Revision: 3779

Added:
   Test-WWW-Declare/t/04-fail.t
   Test-WWW-Declare/t/05-forms.t
Modified:
   Test-WWW-Declare/   (props changed)
   Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm
   Test-WWW-Declare/t/03-mech.t

Log:
 r29882 at caladan:  sartak | 2007-08-03 17:21:41 -0400
 Add failure and form tests


Modified: Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm
==============================================================================
--- Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm	(original)
+++ Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm	Fri Aug  3 17:21:51 2007
@@ -19,33 +19,66 @@
 <a href="good">infinite recursion</a>
 GOOD
 
+   formy => << "FORMY",
+<h1>This page has two forms!</h1>
+<form method="post" name="one" action="result1">
+    <input type="text" size="20" name="clever" />
+    <input type="submit" size="20" value="sub-mits" />
+</form>
+<form method="get" name="two" action="result2">
+    <input type="text" size="20" name="clever" />
+    <input type="submit" size="20" value="sub-mits 2" />
+</form>
+FORMY
+
+    result1 => sub {
+        my $cgi = shift; my $clever = $cgi->param('clever');
+        return "<h1>\U$clever\E</h1>";
+    },
+
+    result2 => sub {
+        my $cgi = shift; my $clever = $cgi->param('clever');
+        return "<h1>\L$clever\E</h1>";
+    },
+
 );
 
-for my $url (keys %content)
+sub wrap_content
 {
-    $content{$url} =~ s/^/        /mg;
+    my ($url, $content) = @_;
+    $content =~ s/^/        /mg;
 
-    $content{$url} = << "WRAPPER";
+    $content = << "WRAPPER";
 <html>
     <head>
         <title>\U$url\E</title>
     </head>
     <body>
-$content{$url}
+$content
     </body>
 </html>
 WRAPPER
+
+    return $content;
+}
+
+sub get {
+    my $page = (split '/', shift)[-1];
+    $page ||= 'index';
+    $page =~ s/\s+//g;
+
+    my $content = $content{$page};
+
+    return if !defined($content);
+    return wrap_content($page, $content->(@_)) if ref($content) eq 'CODE';
+    return wrap_content($page, $content);
 }
 
 sub handle_request {
     my $self = shift;
     my $cgi = shift;
 
-    my $page = (split '/', $cgi->path_info)[-1];
-    $page ||= 'index';
-    $page =~ s/\s+//g;
-
-    if (my $content = $content{$page}) {
+    if (my $content = get($cgi->path_info, $cgi)) {
         print "HTTP/1.0 200 OK\r\n";
         print "Content-Type: text/html\r\nContent-Length: ",
               length($content),

Modified: Test-WWW-Declare/t/03-mech.t
==============================================================================
--- Test-WWW-Declare/t/03-mech.t	(original)
+++ Test-WWW-Declare/t/03-mech.t	Fri Aug  3 17:21:51 2007
@@ -24,4 +24,3 @@
 is($results[1]{name}, "basic connectivity", "2nd test was flow");
 is($results[2]{name}, "check logins", "2nd test was session");
 
-

Added: Test-WWW-Declare/t/04-fail.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/04-fail.t	Fri Aug  3 17:21:51 2007
@@ -0,0 +1,27 @@
+#!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/";
+                content should match qr{This is an index};
+                click href qr{bad};
+                content should match qr{This is a good page}i;
+            };
+        };
+    }
+);
+
+shift @results; # Test::Tester gives 1-based arrays
+is(@results, 2, "had two tests");
+ok(!$results[0]{ok}, "1st test failed");
+ok(!$results[1]{ok}, "2nd test failed");
+
+is($results[0]{name}, "basic connectivity", "1st test was flow");
+is($results[1]{name}, "check logins", "2nd test was session");
+
+

Added: Test-WWW-Declare/t/05-forms.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/05-forms.t	Fri Aug  3 17:21:51 2007
@@ -0,0 +1,44 @@
+#!perl
+use Test::WWW::Declare::Tester tests => 6;
+use warnings;
+use strict;
+
+my @results = run_tests(
+    sub {
+        session "check logins" => run {
+            flow "search1" => check {
+                get "http://localhost:$PORT/formy";
+
+                fill form 'one' => {
+                    clever => 'Modestly',
+                };
+
+                click button 'sub-mits';
+
+                content should match qr{MODESTLY};
+            };
+
+            flow "search2" => check {
+                get "http://localhost:$PORT/formy";
+
+                fill form 'two' => {
+                    clever => 'Verily',
+                };
+
+                click button 'sub-mits 2';
+
+                content should match qr{verily};
+            };
+        };
+    }
+);
+
+shift @results; # Test::Tester gives 1-based arrays
+ok($results[0]{ok}, "1st test passed");
+ok($results[1]{ok}, "2nd test passed");
+ok($results[2]{ok}, "3rd test passed");
+
+is($results[0]{name}, "search1", "1st test was flow");
+is($results[1]{name}, "search2", "2nd test was flow");
+is($results[2]{name}, "check logins", "3rd test was sessions");
+


More information about the Jifty-commit mailing list