Author: dylan
Date: 2005-08-01 11:04:21 -0400 (Mon, 01 Aug 2005)
New Revision: 901
Removed:
trunk/perl/server/t/006_fail_order.t
Modified:
trunk/
Log:
Test case was broken anyway, removing.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1326
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1330
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Deleted: trunk/perl/server/t/006_fail_order.t
===================================================================
--- trunk/perl/server/t/006_fail_order.t 2005-08-01 14:57:58 UTC (rev
900)
+++ trunk/perl/server/t/006_fail_order.t 2005-08-01 15:04:21 UTC (rev
901)
@@ -1,85 +0,0 @@
-#!/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;
- }
- }
- }
- }
-}
-
