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

Leigh Stoller's avatar
Leigh Stoller committed
3
#
4
# Copyright (c) 2000-2015 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24 25 26
#


27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
# 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>

48 49 50 51 52 53 54
use DBI;

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

55 56 57 58 59
($db,$pid,$eid,$test,$dir) = @ARGV;

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

60 61 62
# A counter.
$counter = 0;

63 64 65 66
sub doexit {
    if ($status eq "") {
	$status = "PASS";
    }
67

68
    print "$status\n";
69

70 71 72
    exit(0);
};

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

76 77 78 79 80 81
do {
package TEST;
$eid = $::eid;
$pid = $::pid;
$test = $::test;
$dir = $::dir;
82
$dbh = $::dbh;
83
$db = $::db;
84 85 86

sub tb_prerun {
    my ($cmd,$exitcode) = @_;
87 88
    print "$cmd -force $pid $eid nsfile.ns\n";
    open(TBEXEC,"$cmd -force $pid $eid nsfile.ns 2>&1 |");
89 90 91 92
    while (<TBEXEC>) {
	print $_;
    }
    close(TBEXEC);
93
    $ecode = ($? >> 8);
94

95
#    system("mysqldump --create-options $db > $cmd-$::counter.txt");
96
    $::counter++;
97

98 99 100
    # Forget about specific error codes. Either success or fail.
    if (($exitcode && !$ecode) || (!$exitcode && $ecode)) {
	tb_fail("$cmd - Exit code $ecode. Unexpected");
101 102 103
    }
};
sub tb_compare {
104 105 106 107
    # 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) = @_;
108

109 110 111 112 113 114 115
    my $sth = $dbh->prepare($query);
    $sth->execute;
    my @row;
    my $i;
    my @result;
    my $rowi = 0;
    while (@row = $sth->fetchrow_array) {
116
	@result = @{(@$results)[$rowi]};
117 118 119 120 121
	if ($#row != $#result) {
	    tb_fail("Row $rowi - Length of $#row != expected $#result.");
	}
	for ($i=0;$i<$#row;++$i) {
	    if ($row[$i] ne $result[$i]) {
122
		tb_fail("$rowi/$i - Found $row[$i], expected $result[$i].");
123 124 125 126
	    }
	}
	$rowi++;
    }
127
};
128

129 130
sub tb_run {
    my ($cmd,$exitcode) = @_;
131 132
    print "$cmd -force $pid $eid\n";
    open(TBEXEC,"$cmd -force $pid $eid 2>&1 |");
133 134 135 136
    while (<TBEXEC>) {
	print $_;
    }
    close(TBEXEC);
137
    $ecode = ($? >> 8);
138

139
#    system("mysqldump --create-options $db > $cmd-$::counter.txt");
140 141
    $::counter++;

142 143 144
    # Forget about specific error codes. Either success or fail.
    if (($exitcode && !$ecode) || (!$exitcode && $ecode)) {
	tb_fail("$cmd - Exit code $ecode. Unexpected");
145 146 147 148 149 150 151
    }
};
sub tb_fail {
    $::status = "FAIL - " . $_[0];
    ::doexit;
};

152 153
# 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
154
system("rm -f *.ns");
155 156 157 158 159 160
print "Debug: $dir/nsfile.ns\n";
system("cp -f $dir/nsfile.ns .");
if (($? >> 8) != 0) {
    tb_fail("Could not copy nsfile.");
}

161 162 163 164 165 166
print "Executing $dir/test\n";
do "$dir/test";

};

doexit;