commit d68dd7369ece3a58a5e4cf43c53a5d869ee2874a
parent 549c1cf13efcd4e7947e2c0a5c290f82fa71136f
Author: Oswald Buddenhagen <ossi@users.sf.net>
Date: Tue, 27 Dec 2005 17:31:04 +0000
make the error case output more useful by dumping the entire data set.
Diffstat:
M | src/run-tests.pl | | | 195 | +++++++++++++++++++++++++++++++++++++++++++++++++------------------------------ |
1 file changed, 122 insertions(+), 73 deletions(-)
diff --git a/src/run-tests.pl b/src/run-tests.pl
@@ -306,6 +306,71 @@ sub readbox($)
return ($mu, %ms);
}
+# $boxname
+sub showbox($)
+{
+ my ($bn) = @_;
+
+ my ($mu, %ms) = readbox($bn);
+ print " [ $mu,\n ";
+ my $frst = 1;
+ for my $num (sort {my ($ca, $cb) = ($ms{$a}[0], $ms{$b}[0]); ($ca?$ca:$a+1000) <=> ($cb?$cb:$b+1000)} keys %ms) {
+ if ($frst) {
+ $frst = 0;
+ } else {
+ print ", ";
+ }
+ print "$num, $ms{$num}[0], \"$ms{$num}[1]\"";
+ }
+ print " ],\n";
+}
+
+# $num
+sub showchan()
+{
+ showbox("master");
+ showbox("slave");
+ open(FILE, "<", "slave/.mbsyncstate") or
+ die "Cannot read sync state.\n";
+ $_ = <FILE>;
+ /^1:(\d+) 1:(\d+):(\d+)\n$/;
+ print " [ $1, $2, $3,\n ";
+ my $frst = 1;
+ for (<FILE>) {
+ if (!/^(-?\d+) (-?\d+) (.*)\n$/) {
+ print STDERR "Malformed sync state entry '$_'.\n";
+ next;
+ }
+ if ($frst) {
+ $frst = 0;
+ } else {
+ print ", ";
+ }
+ print "$1, $2, \"$3\"";
+ }
+ print " ],\n";
+ close FILE;
+}
+
+sub show($$@)
+{
+ my ($sx, $tx, @sfx) = @_;
+ my @sp;
+ eval "\@sp = \@x$sx";
+ mkchan($sp[0], $sp[1], @{ $sp[2] });
+ print "my \@x$sx = (\n";
+ showchan();
+ print ");\n";
+ &runsync(@sfx);
+ print "my \@X$tx = (\n";
+ print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ],\n";
+ showchan();
+ print ");\n";
+ print "test(\\\@x$sx, \\\@X$tx);\n\n";
+ rmtree "slave";
+ rmtree "master";
+}
+
# $boxname, $maxuid, @msgs
sub mkbox($$@)
{
@@ -350,135 +415,119 @@ sub mkchan($$@)
# $config, $boxname, $maxuid, @msgs
sub ckbox($$$@)
{
- my ($cfg, $bn, $MU, @MS) = @_;
+ my ($bn, $MU, @MS) = @_;
my ($mu, %ms) = readbox($bn);
if ($mu != $MU) {
- print STDERR "MAXUID mismatch for $bn - expected $MU, got $mu, config: $cfg\n";
- exit 1;
+ print STDERR "MAXUID mismatch for '$bn'.\n";
+ return 1;
}
while (@MS) {
my ($num, $uid, $flg) = (shift @MS, shift @MS, shift @MS);
if (!defined $ms{$num}) {
- print STDERR "no message $bn:$num, config: $cfg\n";
- exit 1;
+ print STDERR "No message $bn:$num.\n";
+ return 1;
}
if ($ms{$num}[0] ne $uid) {
- print STDERR "UID mismatch for $bn:$num - expected $uid, got $ms{$num}[0], config: $cfg\n";
- exit 1;
+ print STDERR "UID mismatch for $bn:$num.\n";
+ return 1;
}
if ($ms{$num}[1] ne $flg) {
- print STDERR "flag mismatch for $bn:$num - expected '$flg', got '$ms{$num}[1]', config: $cfg\n";
- exit 1;
+ print STDERR "Flag mismatch for $bn:$num.\n";
+ return 1;
}
delete $ms{$num};
}
if (%ms) {
- print STDERR "excess messages in '$bn': ".join(", ", sort({$a <=> $b } keys(%ms))).", config: $cfg\n";
- exit 1;
+ print STDERR "Excess messages in '$bn': ".join(", ", sort({$a <=> $b } keys(%ms))).".\n";
+ return 1;
}
+ return 0;
}
# $config, \@master, \@slave, @syncstate
sub ckchan($$$@)
{
my ($cfg, $M, $S, @T) = @_;
+ my $rslt = 0;
open(FILE, "<", "slave/.mbsyncstate") or
die "Cannot read sync state.\n";
- my $l = <FILE>;
- my @ls = <FILE>;
+ chomp(my $l = <FILE>);
+ chomp(my @ls = <FILE>);
close FILE;
- my $xl = "1:".shift(@T)." 1:".shift(@T).":".shift(@T)."\n";
+ my $xl = "1:".shift(@T)." 1:".shift(@T).":".shift(@T);
if ($l ne $xl) {
- print STDERR "Sync state header mismatch.
-Expected: $xl"."Got: $l"."Config: $cfg
-";
- exit 1;
- }
- for $l (@ls) {
- $xl = shift(@T)." ".shift(@T)." ".shift(@T)."\n";
- if ($l ne $xl) {
- print STDERR "Sync state entry mismatch.
-Expected: $xl"."Got: $l"."Config: $cfg
-";
- exit 1;
+ print STDERR "Sync state header mismatch: '$l' instead of '$xl'.\n";
+ $rslt = 1;
+ } else {
+ for $l (@ls) {
+ $xl = shift(@T)." ".shift(@T)." ".shift(@T);
+ if ($l ne $xl) {
+ print STDERR "Sync state entry mismatch: '$l' instead of '$xl'.\n";
+ $rslt = 1;
+ last;
+ }
}
}
- &ckbox($cfg, "master", @{ $M });
- &ckbox($cfg, "slave", @{ $S });
-}
-
-sub test($$)
-{
- my ($sx, $tx) = @_;
- mkchan($$sx[0], $$sx[1], @{ $$sx[2] });
- &runsync(@{ $$tx[0] });
- ckchan(fcfg(@{ $$tx[0] }), $$tx[1], $$tx[2], @{ $$tx[3] });
- rmtree "slave";
- rmtree "master";
+ $rslt |= &ckbox("master", @{ $M });
+ $rslt |= &ckbox("slave", @{ $S });
+ return $rslt;
}
-# $id, $boxname
-sub showbox($$)
+sub printbox($$@)
{
- my ($bn) = @_;
+ my ($bn, $mu, @ms) = @_;
- my ($mu, %ms) = readbox($bn);
print " [ $mu,\n ";
my $frst = 1;
- for my $num (sort {my ($ca, $cb) = ($ms{$a}[0], $ms{$b}[0]); ($ca?$ca:$a+1000) <=> ($cb?$cb:$b+1000)} keys %ms) {
+ while (@ms) {
if ($frst) {
$frst = 0;
} else {
print ", ";
}
- print "$num, $ms{$num}[0], \"$ms{$num}[1]\"";
+ print shift(@ms).", ".shift(@ms).", \"".shift(@ms)."\"";
}
print " ],\n";
}
-# $num
-sub showchan()
+sub printchan($$@)
{
- &showbox("master");
- &showbox("slave");
- open(FILE, "<", "slave/.mbsyncstate") or
- die "Cannot read sync state.\n";
- $_ = <FILE>;
- /^1:(\d+) 1:(\d+):(\d+)\n$/;
- print " [ $1, $2, $3,\n ";
+ my ($m, $s, @t) = @_;
+
+ &printbox("master", @{ $m });
+ &printbox("slave", @{ $s });
+ print " [ ".shift(@t).", ".shift(@t).", ".shift(@t).",\n ";
my $frst = 1;
- for (<FILE>) {
- if (!/^(-?\d+) (-?\d+) (.*)\n$/) {
- print STDERR "Malformed sync state entry '$_'.\n";
- next;
- }
+ while (@t) {
if ($frst) {
$frst = 0;
} else {
print ", ";
}
- print "$1, $2, \"$3\"";
+ print shift(@t).", ".shift(@t).", \"".shift(@t)."\"";
}
print " ],\n";
close FILE;
}
-sub show($$@)
+sub test($$)
{
- my ($sx, $tx, @sfx) = @_;
- my @sp;
- eval "\@sp = \@x$sx";
- mkchan($sp[0], $sp[1], @{ $sp[2] });
- print "my \@x$sx = (\n";
- showchan();
- print ");\n";
- &runsync(@sfx);
- print "my \@X$tx = (\n";
- print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ],\n";
- showchan();
- print ");\n";
- print "test(\\\@x$sx, \\\@X$tx);\n\n";
+ my ($sx, $tx) = @_;
+
+ mkchan($$sx[0], $$sx[1], @{ $$sx[2] });
+ &runsync(@{ $$tx[0] });
+ if (ckchan(fcfg(@{ $$tx[0] }), $$tx[1], $$tx[2], @{ $$tx[3] })) {
+ print "Input:\n";
+ printchan($$sx[0], $$sx[1], @{ $$sx[2] });
+ print "Options:\n";
+ print " [ ".join(", ", map('"'.qm($_).'"', @{ $$tx[0] }))." ],\n";
+ print "Expected result:\n";
+ printchan($$tx[1], $$tx[2], @{ $$tx[3] });
+ print "Actual result:\n";
+ showchan();
+ exit 1;
+ }
rmtree "slave";
rmtree "master";
}