Author: dylan
Date: 2005-08-01 10:57:33 -0400 (Mon, 01 Aug 2005)
New Revision: 899
Added:
trunk/perl/server/t/006_fail_order.t
Log:
bd_'s test case.
Added: trunk/perl/server/t/006_fail_order.t
===================================================================
--- trunk/perl/server/t/006_fail_order.t 2005-08-01 02:18:28 UTC (rev
898)
+++ trunk/perl/server/t/006_fail_order.t 2005-08-01 14:57:33 UTC (rev
899)
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use IO::Socket::INET;
+use Data::Dumper;
+
+sub fmt {
+ my ($prefix, $str) = @_;
+ $str =~ tr/\r//d;
+ my @lines = split /\n/, $str;
+ return join("\n", map { "# $prefix$_" } @lines), "\n";
+}
+
+use constant {
+ CONTINUE => 0,
+ OK => 1,
+ NOK => 2,
+ SKIP => 3,
+};
+
+my @script = (
+ {
+ send => "HAVER\ttest-case/0.0\r\n",
+ expect => [
+ qr{^HAVER.*\r\n} => CONTINUE,
+ qr{\r\n} => SKIP,
+ ],
+ },
+ {
+ send => "IDENT\tt$$\r\n",
+ expect => [
+ qr{^HELLO\tt$$\r\n} => CONTINUE,
+ qr{\r\n} => SKIP,
+ ],
+ },
+ {
+ send => "FOO\r\nPOKE\t42\r\n",
+ expect => [
+ qr{^OUCH} => NOK,
+ qr{^FAIL\tFOO\tunknown.cmd\r\nOUCH\t42\r\n} => OK,
+ qr{^FAIL\t} => NOK,
+ qr{\r\n} => SKIP,
+ ],
+ }
+);
+
+my $buf = '';
+my $h = new IO::Socket::INET(
+ PeerAddr => 'hardison.net',
+ PeerPort => 7575,
+ Proto => 'tcp',
+);
+unless ($h) {
+ SKIP: skip "can't connect: $!", 1;
+ exit 0;
+}
+
+S: while (@script) {
+ my $stage = shift @script;
+ print $h $stage->{send};
+ print fmt("C: ", $stage->{send});
+ while (<$h>) {
+ print fmt("S: ", $_);
+ $buf .= $_;
+ my @expect = @{$stage->{expect}};
+ while (@expect) {
+ my $re = shift @expect;
+ my $action = shift @expect;
+ if ($buf =~ s/^(.*?$re)//) {
+ if ($action == CONTINUE) {
+ next S;
+ } elsif ($action == SKIP) {
+ SKIP: skip "skipping: " . Dumper $1, 1;
+ exit 0;
+ } else {
+ ok($action == OK, "S: FAIL behavior");
+ exit 0;
+ }
+ }
+ }
+ }
+}
+
