tbstub 3.34 KB
Newer Older
1 2
#!/usr/bin/perl

Leigh B. Stoller's avatar
Leigh B. Stoller committed
3 4
#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6 7 8 9
# All rights reserved.
#


10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
# The lack of -w is intentional!  Several variables here are only used
# by the test file and maybe not even there.  Thus -w will cause a lot
# of warnings of variables being used only once.

# tbstub

# This should not be directly called by the user.  This is called from
# tbtest to provide a basic environment for the test scripts to run.  The
# reason to have the tests run in a seperate process it for memory management.
# There is no way to completely clear out the memory used by a package
# other than terminating the interpreter.  Thus to allow each test to
# run in it's own namespace without having a memory leak we put each
# in it's own process.

# The last last of output must be:
#   PASS
#   FAIL <msg>

# Syntax:
#   tbstub <db> <pid> <eid> <testname> <testdir>

31 32 33 34 35 36 37
use DBI;

if ($#ARGV != 4) {
    print STDERR "Do not run directly!\n";
    exit(1);
}

38 39 40 41 42
($db,$pid,$eid,$test,$dir) = @ARGV;

# The status of the test.
$status = "";

43 44 45
# A counter.
$counter = 0;

46 47 48 49
sub doexit {
    if ($status eq "") {
	$status = "PASS";
    }
50

51
    print "$status\n";
52

53 54 55
    exit(0);
};

56
$dbh = DBI->connect("DBI:mysql:database=$db;host=localhost") ||
57 58
    die "Could not connect to DB.\n";

59 60 61 62 63 64
do {
package TEST;
$eid = $::eid;
$pid = $::pid;
$test = $::test;
$dir = $::dir;
65
$dbh = $::dbh;
66
$db = $::db;
67 68 69

sub tb_prerun {
    my ($cmd,$exitcode) = @_;
70 71
    print "$cmd -force $pid $eid nsfile.ns\n";
    open(TBEXEC,"$cmd -force $pid $eid nsfile.ns 2>&1 |");
72 73 74 75
    while (<TBEXEC>) {
	print $_;
    }
    close(TBEXEC);
76
    $ecode = ($? >> 8);
77 78 79

#    system("mysqldump --all $db > $cmd-$::counter.txt");
    $::counter++;
80

81 82 83
    # Forget about specific error codes. Either success or fail.
    if (($exitcode && !$ecode) || (!$exitcode && $ecode)) {
	tb_fail("$cmd - Exit code $ecode. Unexpected");
84 85 86
    }
};
sub tb_compare {
87 88 89 90
    # results is a reference to a list of list references.  I.e.
    # a list of lists.  Each sublist is a list of column values and
    # refers to a row.
    my ($query,$results) = @_;
91

92 93 94 95 96 97 98
    my $sth = $dbh->prepare($query);
    $sth->execute;
    my @row;
    my $i;
    my @result;
    my $rowi = 0;
    while (@row = $sth->fetchrow_array) {
99
	@result = @{(@$results)[$rowi]};
100 101 102 103 104
	if ($#row != $#result) {
	    tb_fail("Row $rowi - Length of $#row != expected $#result.");
	}
	for ($i=0;$i<$#row;++$i) {
	    if ($row[$i] ne $result[$i]) {
105
		tb_fail("$rowi/$i - Found $row[$i], expected $result[$i].");
106 107 108 109
	    }
	}
	$rowi++;
    }
110
};
111

112 113
sub tb_run {
    my ($cmd,$exitcode) = @_;
114 115
    print "$cmd -force $pid $eid\n";
    open(TBEXEC,"$cmd -force $pid $eid 2>&1 |");
116 117 118 119
    while (<TBEXEC>) {
	print $_;
    }
    close(TBEXEC);
120
    $ecode = ($? >> 8);
121 122 123 124

#    system("mysqldump --all $db > $cmd-$::counter.txt");
    $::counter++;

125 126 127
    # Forget about specific error codes. Either success or fail.
    if (($exitcode && !$ecode) || (!$exitcode && $ecode)) {
	tb_fail("$cmd - Exit code $ecode. Unexpected");
128 129 130 131 132 133 134
    }
};
sub tb_fail {
    $::status = "FAIL - " . $_[0];
    ::doexit;
};

135 136
# Clean out any old ns files in the dir (esp. temps made by tbprerun), 
# then copy in the new ns file.
Mac Newbold's avatar
Mac Newbold committed
137
system("rm -f *.ns");
138 139 140 141 142 143
print "Debug: $dir/nsfile.ns\n";
system("cp -f $dir/nsfile.ns .");
if (($? >> 8) != 0) {
    tb_fail("Could not copy nsfile.");
}

144 145 146 147 148 149
print "Executing $dir/test\n";
do "$dir/test";

};

doexit;