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;