[ViewVC] Annotation of: cvs/cvsroot/cf.schmorp.de/dclient/testsuite/tclient/register

#!/usr/bin/env perl

use common::sense;

use Expect;

use constant {
   TIMEOUT     => 10,
   USERS       =>  2,
   STAT_ROLLS  =>  2,
   RACE_ROLLS  =>  2,
};

sub expect {
   my $exp = shift;
   die "unexpected response or timeout"
      unless $exp->expect (TIMEOUT, @_)
}

sub process {
   my $exp = shift;
   $exp->send ("$_[0]\n")
}


my @exp;

for my $u (0 .. USERS - 1) {
   $exp[$u] = new Expect;
}

for my $exp (@exp) {
   $exp->spawn ("$ENV{builddir}/tclient", $ENV{testserver}, $ENV{testport});
}

for my $u (0 .. USERS - 1) {
   expect $exp[$u], "What is your name?";
   process $exp[$u], "/reply testuser$u";
}

for my $exp (@exp) {
   expect $exp, "What is your password?";
   process $exp, "/reply testpass";
}

for my $exp (@exp) {
   expect $exp, "Please type your password again.";
   process $exp, "/reply testpass";
}

for my $exp (@exp) {
   for (0 .. STAT_ROLLS) {
      expect $exp, "Roll again";
      process $exp, "/reply y";
   }
   expect $exp, "Roll again";
   process $exp, "/reply n";
}

for my $exp (@exp) {
   for (0 .. RACE_ROLLS) {
      expect $exp, "Press any key to change outlook";
      process $exp, "/reply n";
   }
   expect $exp, "Press any key to change outlook";
   process $exp, "/reply d";
}

for my $exp (@exp) {
   expect $exp, "Press 'f' to become female";
   process $exp, "/reply m";
}

for my $exp (@exp) {
   expect $exp, "Welcome to Deliantra!";
   # dump-map is immediate, so we don't need to expect anything
   # just look at the log if you are interested
   process $exp, "!dump-map";
   process $exp, "quit_character";
}

for my $exp (@exp) {
   expect $exp, "PERMANENTLY";
   process $exp, "/reply y";
}

for my $exp (@exp) {
   expect $exp, "Ok, quitting";
   expect $exp, "EOF from server";
}

for my $exp (@exp) {
   $exp->soft_close
}
Revision:	1.4
Committed:	Mon Oct 25 03:18:22 2010 UTC (15 years, 11 months ago) by sf-pippijn
Branch:	MAIN
Changes since 1.3:	+2 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	sf-pippijn	1.1	#!/usr/bin/env perl
2
3			use common::sense;
4
5			use Expect;
6
7			use constant {
8	sf-pippijn	1.3	TIMEOUT => 10,
9			USERS => 2,
10			STAT_ROLLS => 2,
11			RACE_ROLLS => 2,
12	sf-pippijn	1.1	};
13
14			sub expect {
15	sf-pippijn	1.3	my $exp = shift;
16	sf-pippijn	1.1	die "unexpected response or timeout"
17			unless $exp->expect (TIMEOUT, @_)
18			}
19
20			sub process {
21	sf-pippijn	1.3	my $exp = shift;
22	sf-pippijn	1.1	$exp->send ("$_[0]\n")
23			}
24
25
26	sf-pippijn	1.3	my @exp;
27	sf-pippijn	1.1
28	sf-pippijn	1.4	for my $u (0 .. USERS - 1) {
29	sf-pippijn	1.3	$exp[$u] = new Expect;
30			}
31	sf-pippijn	1.1
32	sf-pippijn	1.3	for my $exp (@exp) {
33			$exp->spawn ("$ENV{builddir}/tclient", $ENV{testserver}, $ENV{testport});
34			}
35	sf-pippijn	1.1
36	sf-pippijn	1.4	for my $u (0 .. USERS - 1) {
37	sf-pippijn	1.3	expect $exp[$u], "What is your name?";
38			process $exp[$u], "/reply testuser$u";
39			}
40	sf-pippijn	1.1
41	sf-pippijn	1.3	for my $exp (@exp) {
42			expect $exp, "What is your password?";
43			process $exp, "/reply testpass";
44	sf-pippijn	1.1	}
45
46	sf-pippijn	1.3	for my $exp (@exp) {
47			expect $exp, "Please type your password again.";
48			process $exp, "/reply testpass";
49	sf-pippijn	1.1	}
50
51	sf-pippijn	1.3	for my $exp (@exp) {
52			for (0 .. STAT_ROLLS) {
53			expect $exp, "Roll again";
54			process $exp, "/reply y";
55			}
56			expect $exp, "Roll again";
57			process $exp, "/reply n";
58			}
59	sf-pippijn	1.1
60	sf-pippijn	1.3	for my $exp (@exp) {
61			for (0 .. RACE_ROLLS) {
62			expect $exp, "Press any key to change outlook";
63			process $exp, "/reply n";
64			}
65			expect $exp, "Press any key to change outlook";
66			process $exp, "/reply d";
67			}
68	sf-pippijn	1.1
69	sf-pippijn	1.3	for my $exp (@exp) {
70			expect $exp, "Press 'f' to become female";
71			process $exp, "/reply m";
72			}
73	sf-pippijn	1.1
74	sf-pippijn	1.3	for my $exp (@exp) {
75			expect $exp, "Welcome to Deliantra!";
76			# dump-map is immediate, so we don't need to expect anything
77			# just look at the log if you are interested
78			process $exp, "!dump-map";
79			process $exp, "quit_character";
80			}
81
82			for my $exp (@exp) {
83			expect $exp, "PERMANENTLY";
84			process $exp, "/reply y";
85			}
86	sf-pippijn	1.1
87	sf-pippijn	1.3	for my $exp (@exp) {
88			expect $exp, "Ok, quitting";
89			expect $exp, "EOF from server";
90			}
91
92			for my $exp (@exp) {
93			$exp->soft_close
94			}