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

Leigh Stoller's avatar
Leigh Stoller committed
3 4 5 6 7 8 9
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# 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 50 51 52 53 54 55
sub doexit {
    if ($status eq "") {
	$status = "PASS";
    }
    
    print "$status\n";
    
    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 $pid $eid nsfile.ns\n";
    open(TBEXEC,"$cmd $pid $eid nsfile.ns 2>&1 |");
72 73 74 75
    while (<TBEXEC>) {
	print $_;
    }
    close(TBEXEC);
76
    $ecode = ($? >> 8);
77 78 79 80

#    system("mysqldump --all $db > $cmd-$::counter.txt");
    $::counter++;
    
81 82
    if ($ecode != $exitcode) {
	tb_fail("$cmd - Exit code $ecode, expected $exitcode");
83 84 85
    }
};
sub tb_compare {
86 87 88 89 90 91 92 93 94 95 96 97
    # 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) = @_;
    
    my $sth = $dbh->prepare($query);
    $sth->execute;
    my @row;
    my $i;
    my @result;
    my $rowi = 0;
    while (@row = $sth->fetchrow_array) {
98
	@result = @{(@$results)[$rowi]};
99 100 101 102 103
	if ($#row != $#result) {
	    tb_fail("Row $rowi - Length of $#row != expected $#result.");
	}
	for ($i=0;$i<$#row;++$i) {
	    if ($row[$i] ne $result[$i]) {
104
		tb_fail("$rowi/$i - Found $row[$i], expected $result[$i].");
105 106 107 108
	    }
	}
	$rowi++;
    }
109
};
110

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

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

124 125
    if ($ecode != $exitcode) {
	tb_fail("$cmd - Exit code $ecode, expected $exitcode");
126 127 128 129 130 131 132
    }
};
sub tb_fail {
    $::status = "FAIL - " . $_[0];
    ::doexit;
};

133 134 135 136 137 138
print "Debug: $dir/nsfile.ns\n";
system("cp -f $dir/nsfile.ns .");
if (($? >> 8) != 0) {
    tb_fail("Could not copy nsfile.");
}

139 140 141 142 143 144
print "Executing $dir/test\n";
do "$dir/test";

};

doexit;