tests/actofgod: New, disabled for now because it oopses
This is a fairly comprehensive test of the deity commands to edit game state: edit, setresource, setsector, give, swapsector. The test makes edit screw up game state, triggering oopses. The server refuses to start without -F then, and empdump -x warns "export has errors, not importable as is". Until these bugs are fixed, skip this test in "make check". Signed-off-by: Markus Armbruster <armbru@pond.sub.org>
This commit is contained in:
parent
04da480e02
commit
aa870f5d91
8 changed files with 7526 additions and 0 deletions
1
Make.mk
1
Make.mk
|
|
@ -255,6 +255,7 @@ ifeq ($(empthread),LWP)
|
|||
else
|
||||
@echo "$(srcdir)/tests/smoke-test SKIPPED"
|
||||
endif
|
||||
@echo "$(srcdir)/tests/actofgod-test SKIPPED"
|
||||
|
||||
|
||||
### Implicit rules
|
||||
|
|
|
|||
59
tests/actofgod-test
Executable file
59
tests/actofgod-test
Executable file
|
|
@ -0,0 +1,59 @@
|
|||
#!/bin/sh -e
|
||||
# Acts of god test for Empire
|
||||
|
||||
if [ $# -ne 1 ]
|
||||
then echo "Usage: $0 SRCDIR" >&2; exit 1
|
||||
fi
|
||||
|
||||
srcdir="$1"
|
||||
|
||||
. "$srcdir"/tests/test-common.sh
|
||||
|
||||
#
|
||||
# Currently expected to work only with thread package LWP, because:
|
||||
#
|
||||
# - Thread scheduling is reliably deterministic only with LWP
|
||||
# - Shell builtin kill appears not to do the job in MinGW
|
||||
# - The Windows server tries to run as service when -d isn't
|
||||
# specified
|
||||
#
|
||||
# TODO address these shortcomings.
|
||||
#
|
||||
if [ `sed -n 's/empthread *:= *\(.*\)/\1/p' <GNUmakefile` != LWP ]
|
||||
then echo "Warning: test not expected to work with this thread package!" >&2
|
||||
fi
|
||||
|
||||
create_sandbox
|
||||
cat >>sandbox/etc/empire/econfig <<EOF
|
||||
WORLD_X 24
|
||||
WORLD_Y 16
|
||||
EOF
|
||||
|
||||
exec 3>sandbox/actofgod.out
|
||||
|
||||
# Create world, hide creation output
|
||||
src/util/files -e sandbox/etc/empire/econfig -f >&3
|
||||
cp -r sandbox/var/empire/tel sandbox/var/empire/empty.tel
|
||||
start_server
|
||||
src/client/empire POGO peter <"$srcdir"/tests/actofgod/init_script >/dev/null
|
||||
stop_server
|
||||
mv sandbox/var/empire/tel sandbox/var/empire/init.tel
|
||||
mv sandbox/var/empire/empty.tel sandbox/var/empire/tel
|
||||
mv sandbox/var/empire/journal.log sandbox/var/empire/init.journal.log
|
||||
mv sandbox/var/empire/server.log sandbox/var/empire/init.server.log
|
||||
|
||||
# Start server
|
||||
start_server
|
||||
|
||||
# Feed input
|
||||
perl "$srcdir"/tests/actofgod/geninput.pl | src/client/empire POGO peter >/dev/null
|
||||
|
||||
# Stop server
|
||||
stop_server
|
||||
|
||||
exec 3>&-
|
||||
|
||||
src/util/empdump -e sandbox/etc/empire/econfig -x >sandbox/actofgod.xdump
|
||||
|
||||
# Test completed; compare results
|
||||
cmp_out actofgod.out var/empire/server.log var/empire/journal.log actofgod.xdump
|
||||
1
tests/actofgod/actofgod.out
Normal file
1
tests/actofgod/actofgod.out
Normal file
|
|
@ -0,0 +1 @@
|
|||
All praise to POGO!
|
||||
5457
tests/actofgod/actofgod.xdump
Normal file
5457
tests/actofgod/actofgod.xdump
Normal file
File diff suppressed because it is too large
Load diff
361
tests/actofgod/geninput.pl
Executable file
361
tests/actofgod/geninput.pl
Executable file
|
|
@ -0,0 +1,361 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# Assumed initial state:
|
||||
# nats POGO, 1..5, $MAXNOC-1
|
||||
# sects
|
||||
# x>0,y>0 own 1
|
||||
# x<-1,y>0 own 2
|
||||
# x>0,y<0 own 3
|
||||
# x<-1,y<0 own 0
|
||||
# all wilderness, rest sea
|
||||
# owned sectors have 1m 1c
|
||||
# units 5 cs #0..4, 5 f1 #0..4, 5 sup #0..4, all in 1,-1 owned by 3
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
my $MAXNOC = 99;
|
||||
my $xmax = 31;
|
||||
my $ymax = 15;
|
||||
my $STAT_GOD = 5;
|
||||
my $INT_MAX = 0x7fffffff;
|
||||
my $INT_MIN = -$INT_MAX - 1;
|
||||
|
||||
my %ef2edit = (
|
||||
sect => 'l',
|
||||
ship => 's',
|
||||
plane => 'p',
|
||||
land => 'u',
|
||||
nuke => 'n',
|
||||
nat => 'c',
|
||||
);
|
||||
|
||||
my %edit2setres = (
|
||||
i => 'i',
|
||||
g => 'g',
|
||||
c => 'o',
|
||||
f => 'f',
|
||||
u => 'u',
|
||||
);
|
||||
|
||||
my %edit2setsect = (
|
||||
o => 'ow',
|
||||
O => 'ol',
|
||||
i => 'i',
|
||||
g => 'g',
|
||||
c => 'oi',
|
||||
e => 'e',
|
||||
M => 'mi',
|
||||
m => 'mo',
|
||||
a => 'a',
|
||||
w => 'w',
|
||||
f => 'f',
|
||||
u => 'u',
|
||||
);
|
||||
|
||||
sub edit {
|
||||
my ($ef, $id, $key, @rest) = @_;
|
||||
my $args = join(' ', @rest);
|
||||
print "edit $ef2edit{$ef} $id $key $args\n";
|
||||
}
|
||||
|
||||
sub iedit {
|
||||
my ($ef, $id, @rest) = @_;
|
||||
print "edit $ef2edit{$ef} $id\n";
|
||||
for my $inp (@rest) {
|
||||
print "$inp\n";
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
sub next_id {
|
||||
my ($ef, $id) = @_;
|
||||
if ($ef ne 'sect') {
|
||||
return $id + 1;
|
||||
}
|
||||
my ($x, $y) = split /,/, $id;
|
||||
$x += 2;
|
||||
return "$x,$y";
|
||||
}
|
||||
|
||||
sub edit_int1 {
|
||||
my ($ef, $id, $key, $lob, $upb) = @_;
|
||||
edit($ef, $id, $key, $lob);
|
||||
$id = next_id($ef, $id);
|
||||
edit($ef, $id, $key, $lob - 1)
|
||||
if ($lob > $INT_MIN);
|
||||
$id = next_id($ef, $id);
|
||||
edit($ef, $id, $key, $upb);
|
||||
$id = next_id($ef, $id);
|
||||
edit($ef, $id, $key, $upb + 1)
|
||||
if ($upb < $INT_MAX);
|
||||
}
|
||||
|
||||
sub edit_int {
|
||||
my ($ef, $id, @rest) = @_;
|
||||
for my $it (@rest) {
|
||||
edit_int1($ef, $id, @$it);
|
||||
}
|
||||
}
|
||||
|
||||
sub setres {
|
||||
my ($id, $key, $val) = @_;
|
||||
print "setres $key $id $val\n";
|
||||
}
|
||||
|
||||
sub setsect {
|
||||
my ($id, $key, $val) = @_;
|
||||
print "setsect $key $id $val\n";
|
||||
}
|
||||
|
||||
sub give {
|
||||
my ($id, $key, $val) = @_;
|
||||
print "give $key $id $val\n";
|
||||
}
|
||||
|
||||
sub swaps {
|
||||
my ($id1, $id2) = @_;
|
||||
print "swaps $id1 $id2\ny\n";
|
||||
}
|
||||
|
||||
## Sector
|
||||
|
||||
# invalid key
|
||||
edit('sect', '0,0', '@', 0);
|
||||
setres('0,0', '@', 0);
|
||||
setsect('0,0', '@', 0);
|
||||
give('0,0', '@', 0);
|
||||
|
||||
# own oldown che_target
|
||||
for my $key ('o', 'O', 'X') {
|
||||
edit('sect', '1,7', $key, 0);
|
||||
edit('sect', '1,7', $key, -1);
|
||||
edit('sect', '3,7', $key, $MAXNOC - 1);
|
||||
edit('sect', '3,7', $key, $MAXNOC);
|
||||
}
|
||||
edit('sect', '5,7', 'o', 2);
|
||||
for my $key ('ow', 'ol') {
|
||||
setsect('7,7', $key, 0);
|
||||
setsect('7,7', $key, -1);
|
||||
setsect('9,7', $key, $MAXNOC - 1);
|
||||
setsect('9,7', $key, $MAXNOC);
|
||||
}
|
||||
setsect('11,7', 'ow', 2);
|
||||
|
||||
# x,y (copy)
|
||||
edit('sect', '1,7', 'L', '1,-7');
|
||||
edit('sect', '3,-7', 'L', '3,-7', 'L', '1,0');
|
||||
|
||||
# effic mobil iron gmin fertil oil uran work loyalty che pstage ptime
|
||||
# fallout avail mines road rail defense
|
||||
sub sect_int {
|
||||
for my $it (@_) {
|
||||
my ($key, $lob, $upb) = @$it;
|
||||
edit_int1('sect', '1,1', $key, $lob, $upb);
|
||||
my $rkey = $edit2setres{$key};
|
||||
if (defined $rkey) {
|
||||
$upb = 100;
|
||||
setres('2,2', $rkey, $lob);
|
||||
setres('4,2', $rkey, $lob - 1);
|
||||
setres('6,2', $rkey, $upb);
|
||||
setres('8,2', $rkey, $upb + 1);
|
||||
}
|
||||
my $skey = $edit2setsect{$key};
|
||||
if (defined $skey) {
|
||||
setsect('1,3', $skey, $INT_MIN);
|
||||
setsect('3:7,3', $skey, 1);
|
||||
setsect('5,3', $skey, $INT_MAX);
|
||||
setsect('7,3', $skey, -1);
|
||||
}
|
||||
}
|
||||
}
|
||||
sect_int(
|
||||
['e', 0, 100],
|
||||
['m', -127, 127],
|
||||
['i', 0, 127],
|
||||
['g', 0, 127],
|
||||
['f', 0, 127],
|
||||
['c', 0, 127],
|
||||
['u', 0, 127],
|
||||
['w', 0, 100],
|
||||
['l', 0, 127],
|
||||
['x', 0, 255],
|
||||
['p', 0, 4],
|
||||
['t', 0, 32767],
|
||||
['F', 0, 9999],
|
||||
['a', 0, 9999],
|
||||
['M', 0, 32767],
|
||||
['R', 0, 100],
|
||||
['r', 0, 100],
|
||||
['d', 0, 100],
|
||||
);
|
||||
|
||||
# dist
|
||||
edit('sect', '2,4', 'D', '4,4');
|
||||
edit('sect', '4,4', 'D', '4,4');
|
||||
|
||||
# des newdes
|
||||
for my $key ('s', 'S') {
|
||||
edit('sect', '6,4', $key, '+');
|
||||
edit('sect', '6,4', $key, '+');
|
||||
edit('sect', '8,4', $key, '+');
|
||||
edit('sect', '8,4', $key, ',');
|
||||
}
|
||||
|
||||
# multiple arguments
|
||||
edit('sect', '1,5', 'm', 1, 'a', 1);
|
||||
|
||||
# interactive edit
|
||||
iedit('sect', '3,5', 'm 2', 'a 1');
|
||||
|
||||
# give
|
||||
give('2,6', 'l', $INT_MIN);
|
||||
give('4:8,6', 'c', 1);
|
||||
give('6,6', 'c', $INT_MAX);
|
||||
give('8,6', 'c', -1);
|
||||
|
||||
# swapsector
|
||||
swaps('-2,2', '2,-2');
|
||||
|
||||
## Ship, plane, land unit
|
||||
|
||||
for my $ef ('ship', 'plane', 'land') {
|
||||
# invalid key
|
||||
edit($ef, 0, '@', 0);
|
||||
# own
|
||||
edit($ef, 0, 'O', 0);
|
||||
edit($ef, 0, 'O', -1);
|
||||
edit($ef, 1, 'O', $MAXNOC - 1);
|
||||
edit($ef, 1, 'O', $MAXNOC);
|
||||
edit($ef, 2, 'O', 2);
|
||||
# uid (copy)
|
||||
edit($ef, 3, 'U', 5, 'U', 3);
|
||||
edit($ef, 0, 'U', 0, 'U', -1);
|
||||
# x,y
|
||||
my $key = $ef eq 'plane' ? 'l' : 'L';
|
||||
edit($ef, 2, $key, '3,-1');
|
||||
edit($ef, 3, $key, '1,-1');
|
||||
}
|
||||
|
||||
# ship: effic mobil tech pstage ptime milit
|
||||
edit_int('ship', 2, (
|
||||
['E', 0, 100],
|
||||
['M', -127, 127],
|
||||
['T', 0, 32767],
|
||||
['a', 0, 4],
|
||||
['b', 0, 32767],
|
||||
['m', 0, 50],
|
||||
));
|
||||
|
||||
# plane: effic mobil range tech
|
||||
edit_int('plane', 2, (
|
||||
['e', 0, 100],
|
||||
['m', -127, 127],
|
||||
['r', 0, 9],
|
||||
['t', 50, 32767],
|
||||
));
|
||||
|
||||
# land: effic mobil tech harden retreat milit
|
||||
edit_int('land', 2, (
|
||||
['e', 0, 100],
|
||||
['M', -127, 127],
|
||||
['t', 50, 32767],
|
||||
['F', 0, 127],
|
||||
['Z', 0, 100],
|
||||
['m', 0, 25],
|
||||
));
|
||||
|
||||
# fleet, wing, army
|
||||
sub unit_group {
|
||||
my ($ef, $key) = @_;
|
||||
edit($ef, 2, $key, '~');
|
||||
edit($ef, 3, $key, 'a');
|
||||
}
|
||||
unit_group('ship', 'F');
|
||||
unit_group('plane', 'w');
|
||||
unit_group('land', 'a');
|
||||
|
||||
# rpath, rflags
|
||||
for my $ef ('ship', 'land') {
|
||||
edit($ef, 2, 'R', '""');
|
||||
edit($ef, 3, 'R', 'jj');
|
||||
# Take care to have only valid bits set in final state
|
||||
edit($ef, 2, 'W', 0, 'W', 1);
|
||||
edit($ef, 3, 'W', 513, 'W', 1030, 'W', 2);
|
||||
}
|
||||
|
||||
# plane: flags
|
||||
# Take care to have only valid bits set in final state
|
||||
edit('plane', 2, 'f', 4);
|
||||
|
||||
# carrier
|
||||
sub unit_carrier {
|
||||
my ($ef, $skey, $pkey) = @_;
|
||||
edit($ef, 2, $skey, -1, $skey, 9999);
|
||||
edit($ef, 3, $skey, 3);
|
||||
edit($ef, 4, $skey, 4, $pkey, 4);
|
||||
}
|
||||
unit_carrier('plane', 's', 'y');
|
||||
unit_carrier('land', 'S', 'Y');
|
||||
|
||||
# interactive edit
|
||||
iedit('ship', 0, 'M 2', 'm 1', 'f 1');
|
||||
iedit('plane', 0, 'm 2', 'y -1');
|
||||
iedit('land', 0, 'M 2', 'Y -1');
|
||||
|
||||
## Nation
|
||||
|
||||
# invalid key
|
||||
edit('nat', 0, '@', 0);
|
||||
|
||||
# btus reserve timeused money
|
||||
|
||||
edit_int('nat', 1, (
|
||||
['b', 0, 640],
|
||||
['m', 0, 2147483647],
|
||||
['u', 0, 86400],
|
||||
['M', -2147483648, 2147483647],
|
||||
));
|
||||
|
||||
# tgms
|
||||
# Take care to use ones that won't receive further telegrams
|
||||
edit('nat', 6, 't', -1);
|
||||
edit('nat', 7, 't', 65536);
|
||||
|
||||
# tlev rlev elev hlev
|
||||
for my $key ('T', 'R', 'E', 'H') {
|
||||
edit('nat', 1, $key, 3.14);
|
||||
edit('nat', 2, $key, 100);
|
||||
edit('nat', 3, $key, -1);
|
||||
}
|
||||
|
||||
# cnam
|
||||
edit('nat', 1, 'n', 'POGO');
|
||||
edit('nat', 2, 'n', '2');
|
||||
edit('nat', 3, 'n', 'drei');
|
||||
|
||||
# pnam
|
||||
edit('nat', 1, 'r', 1);
|
||||
edit('nat', 2, 'r', '012345678901234567890123456789');
|
||||
|
||||
# xcap,ycap xorg,yorg
|
||||
for my $key ('c', 'o') {
|
||||
edit('nat', 1, $key, '0,0');
|
||||
edit('nat', 2, $key, '2,0');
|
||||
}
|
||||
|
||||
# status
|
||||
# Refs to nats with status 0 are invalid, take care to use
|
||||
# unreferenced ones for that
|
||||
edit('nat', 6, 's', 0);
|
||||
edit('nat', 7, 's', -1);
|
||||
edit('nat', 4, 's', $STAT_GOD);
|
||||
edit('nat', 5, 's', $STAT_GOD + 1);
|
||||
|
||||
# interactive edit
|
||||
iedit('nat', 5, 'b 640', 'T 1');
|
||||
|
||||
## Epilog: read telegrams (they're not in xdump)
|
||||
for my $cnum (0, 1, 2, 3, 4, 5, 98) {
|
||||
print "read $cnum\n";
|
||||
}
|
||||
36
tests/actofgod/init_script
Normal file
36
tests/actofgod/init_script
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
edit c 0 T 400
|
||||
des * -
|
||||
des -12:11,0 .
|
||||
des -1:0,-8:7 .
|
||||
add 1 1 1 p
|
||||
add 2 2 2 p
|
||||
add 3 3 3 p
|
||||
add 4 4 4 p
|
||||
add 5 5 5 p
|
||||
add 6 6 6 v
|
||||
add 7 7 7 v
|
||||
add 98 98 98 g
|
||||
give m * 1
|
||||
setsect ow * ?xloc>0&yloc>0 1
|
||||
setsect ow * ?xloc<-1&yloc>0 2
|
||||
setsect ow * ?xloc>0&yloc<0 3
|
||||
give m * ?own=0 -1
|
||||
give c * ?own#0 1
|
||||
des 1,-1 h
|
||||
setse av 1,-1 9999
|
||||
give l 1,-1 9999
|
||||
give h 1,-1 9999
|
||||
give o 1,-1 9999
|
||||
give r 1,-1 9999
|
||||
give m 1,-1 999
|
||||
buil s 1,-1 cs 5 100
|
||||
des 1,-1 *
|
||||
buil p 1,-1 f1 5 100
|
||||
des 1,-1 !
|
||||
buil l 1,-1 sup 5 100
|
||||
edit l 3,-1 L 1,-1
|
||||
edit c 1 t 0 s 4
|
||||
edit c 2 t 0 s 4
|
||||
edit c 3 t 0 s 4
|
||||
edit c 4 t 0 s 4
|
||||
edit c 5 t 0 s 4
|
||||
1590
tests/actofgod/journal.log
Normal file
1590
tests/actofgod/journal.log
Normal file
File diff suppressed because it is too large
Load diff
21
tests/actofgod/server.log
Normal file
21
tests/actofgod/server.log
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
------------------------------------------------------
|
||||
Empire server (pid 42) started
|
||||
Update schedule read
|
||||
No update scheduled
|
||||
Listening on 127.0.0.1
|
||||
Connect from 127.0.0.1
|
||||
Connect from 127.0.0.1
|
||||
tester@127.0.0.1 using country #0
|
||||
tester@127.0.0.1 logged in as country #0
|
||||
Oops: id < 0 in ../src/lib/common/file.c:973
|
||||
Oops: id < 0 in ../src/lib/common/file.c:973
|
||||
Oops: id < 0 in ../src/lib/common/file.c:973
|
||||
Oops: item[i] < 0 in ../src/lib/subs/sect.c:98
|
||||
Oops: item[i] < 0 in ../src/lib/subs/sect.c:98
|
||||
Oops: new >= nclink[type] in ../src/lib/common/cargo.c:190
|
||||
Oops: ship >= 0 && land >= 0 in ../src/lib/subs/plane.c:77
|
||||
Oops: new >= nclink[type] in ../src/lib/common/cargo.c:190
|
||||
Oops: ship >= 0 && land >= 0 in ../src/lib/subs/land.c:78
|
||||
tester@127.0.0.1 logged out, country #0
|
||||
Shutdown commencing (cleaning up threads.)
|
||||
Server shutting down on signal 15
|
||||
Loading…
Add table
Add a link
Reference in a new issue