[Bps-public-commit] r15369 - in Test-HTTP-Server-Simple-StashWarnings/trunk: .

[sartak at bestpractical.com]

Author: sartak
Date: Fri Aug 22 10:02:08 2008
New Revision: 15369

Added:
   Test-HTTP-Server-Simple-StashWarnings/trunk/t/
   Test-HTTP-Server-Simple-StashWarnings/trunk/t/001-basic.t
Modified:
   Test-HTTP-Server-Simple-StashWarnings/trunk/   (props changed)

Log:
 r70214 at onn:  sartak | 2008-08-22 10:02:02 -0400
 Tests!


Added: Test-HTTP-Server-Simple-StashWarnings/trunk/t/001-basic.t
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple-StashWarnings/trunk/t/001-basic.t	Fri Aug 22 10:02:08 2008
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 8;
+use WWW::Mechanize;
+use Storable 'thaw';
+
+my $url = My::Test::Server->new->started_ok("created test server");
+ok($url, "got a url: $url");
+
+my $mech = WWW::Mechanize->new;
+$mech->get("$url/no_warnings");
+
+$mech->get("/__test_warnings");
+my @warnings = @{ thaw($mech->content) };
+is(@warnings, 0, "no warnings yet");
+
+$mech->get("$url/warn");
+
+$mech->get("$url/__test_warnings");
+ at warnings = @{ thaw($mech->content) };
+is(@warnings, 1, "got a warning!");
+like($warnings[0], qr/^We're out of toilet paper sir!/);
+
+$mech->get("$url/warn");
+$mech->get("$url/warn");
+
+$mech->get("$url/__test_warnings");
+ at warnings = @{ thaw($mech->content) };
+is(@warnings, 2, "got two warnings! warnings are cleared after fetching them");
+like($warnings[0], qr/^We're out of toilet paper sir!/);
+like($warnings[1], qr/^We're out of toilet paper sir!/);
+
+BEGIN {
+    package My::Test::Server;
+    use base qw/Test::HTTP::Server::Simple::StashWarnings HTTP::Server::Simple::CGI/;
+
+    sub handle_request {
+        my $self = shift;
+        my $cgi = shift;
+
+        if ($cgi->path_info eq '/warn') {
+            warn "We're out of toilet paper sir!";
+        }
+    }
+
+    sub test_warning_path { "/__test_warnings" }
+}
+