Get rid of this obsolete script.
This commit is contained in:
Alexandre Julliard
parent
4583a10fb6
commit
9a27b8b961
276
tools/testrun
276
tools/testrun
|
|
@ -1,276 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
# Copyright 1996-1998 Marcus Meissner
|
||||
# IPC remove code Copyright 1995 Michael Veksler
|
||||
#
|
||||
# This library is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU Lesser General Public
|
||||
# License as published by the Free Software Foundation; either
|
||||
# version 2.1 of the License, or (at your option) any later version.
|
||||
#
|
||||
# This library 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
|
||||
# Lesser General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU Lesser General Public
|
||||
# License along with this library; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
#
|
||||
# NOTES:
|
||||
#
|
||||
# This perl script automatically test runs ALL windows .exe and .scr binaries
|
||||
# it finds (and can access) on your computer. It creates a subdirectory called
|
||||
# runs/ and stores the output there. It also does (unique) diffs between runs.
|
||||
#
|
||||
# It only reruns the test if ChangeLog or the executeable is NEWER than the
|
||||
# run file. (If you want to rerun everything inbetween releases, touch
|
||||
# ChangeLog.)
|
||||
|
||||
#
|
||||
# BEGIN OF USER CONFIGURATION
|
||||
#
|
||||
# Path to WINE executeable. If not specified, 'wine' is searched in the path.
|
||||
#
|
||||
$wine = 'wine';
|
||||
#
|
||||
# WINE options. -managed when using a windowmanager is probably not good in
|
||||
# automatic testruns.
|
||||
#
|
||||
$wineoptions='';
|
||||
#
|
||||
# Path to WINE ChangeLog. Used as timestamp for new releases...
|
||||
#
|
||||
$changelog = '/home/marcus/wine/ChangeLog';
|
||||
#
|
||||
# How long before automatically killing all subprocesses
|
||||
# 30 is good for automatic testing, 300 or more for interactive testing.
|
||||
#
|
||||
$waittime = 50;
|
||||
#
|
||||
#diff command
|
||||
#
|
||||
$diff='diff -u';
|
||||
#
|
||||
# truncate at how-much-lines
|
||||
#
|
||||
$trunclines=200;
|
||||
#
|
||||
$<||die "Running this script under UID 0 is a great security risk (and risk for existing windows installations on mounted DOS/W95 partitions). If you really want to, comment out this line.\n";
|
||||
#
|
||||
# END OF USER CONFIGURATION
|
||||
#
|
||||
|
||||
if (! -d "runs") { die "no subdirectory runs/ found in $cwd. Please create one first!\n";}
|
||||
|
||||
# look for the exact path to wine executeable in case we need it for a
|
||||
# replacement changelog.
|
||||
if (! ($wine =~ /\//)) { # no path specified. Look it up.
|
||||
@paths = split(/:/,$ENV{'PATH'});
|
||||
foreach $path (@paths) {
|
||||
if (-e "$path/$wine" && -x "$path/$wine") {
|
||||
$wine = "$path/$wine";
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# if we don't have a changelog use the modification date of the WINE executeable
|
||||
if (! -e $changelog) {
|
||||
$changelog = $wine;
|
||||
}
|
||||
|
||||
# sanity check so we just fill runs/ with errors.
|
||||
(-x $wine) || die "no $wine executable found!\n";
|
||||
# dito. will print usage
|
||||
system("$wine -h >/dev/null")||die "wine call failed:$!\n";
|
||||
|
||||
print "Using $wine as WINE executeable.\n";
|
||||
print "Using $changelog as testrun timereference.\n";
|
||||
|
||||
chomp($cwd = `pwd`);
|
||||
|
||||
# Find out all present semaphores so we don't remove them later.
|
||||
$IPC_RMID=0;
|
||||
$USER=$ENV{'USER'};
|
||||
open(IPCS,"ipcs|");
|
||||
while(<IPCS>) {
|
||||
split;
|
||||
# try to find out the IPC-ID, assume it is the first number.
|
||||
foreach (@_) {
|
||||
$_ ne int($_) && next; # not a decimal number
|
||||
$num=$_;
|
||||
last;
|
||||
}
|
||||
if (/sem/i .. /^\s*$/ ) {
|
||||
index($_,$USER)>=0 || next;
|
||||
$sem_used{$num}=1;
|
||||
print "found $num\n";
|
||||
}
|
||||
}
|
||||
close(IPCS);
|
||||
|
||||
sub kill_subprocesses {
|
||||
local($killedalready,%parentof,%kids,$changed,%cmdline);
|
||||
|
||||
# FIXME: substitute ps command that shows PID,PPID and COMMAND
|
||||
# On Linux' latest procps this is "ps aulc"
|
||||
#
|
||||
open(PSAUX,"ps aulc|");
|
||||
# lookup all processes, remember their parents and cmdlines.
|
||||
%parentof=();
|
||||
$xline = <PSAUX>; # fmtline
|
||||
@psformat = split(/\s\s*/,$xline);
|
||||
|
||||
psline: while (<PSAUX>) {
|
||||
chop;
|
||||
@psline = split(/\s\s*/);
|
||||
$pid=0;
|
||||
for ($i=0;$i<=$#psformat;$i++) {
|
||||
if ($psformat[$i] =~ /COMMAND/) {
|
||||
die unless $pid;
|
||||
$cmdline{$pid}=$psline[$i];
|
||||
break;
|
||||
}
|
||||
if ($psformat[$i] =~ /PPID/ ) {
|
||||
$parentof{$pid} = $psline[$i];
|
||||
next;
|
||||
}
|
||||
if ($psformat[$i] =~ /PID/ ) {
|
||||
$pid = $psline[$i];
|
||||
next;
|
||||
}
|
||||
}
|
||||
}
|
||||
close(PSAUX);
|
||||
|
||||
# find out all kids of this perlscript
|
||||
%kids = ();
|
||||
$kids{$$} = 1;
|
||||
$changed = 1;
|
||||
while ($changed) {
|
||||
$changed = 0;
|
||||
foreach (keys %parentof) {
|
||||
next if ($kids{$_});
|
||||
if ($kids{$parentof{$_}}) {
|
||||
$changed = 1;
|
||||
$kids{$_}=1;
|
||||
}
|
||||
}
|
||||
}
|
||||
# .. but do not consider us for killing
|
||||
delete $kids{$$};
|
||||
# remove all processes killed in the meantime from %killedalready.
|
||||
foreach $pid (keys %killedalready) {
|
||||
delete $killedalready{$pid} if (!$kids{$pid} );
|
||||
}
|
||||
# kill all subprocesses called 'wine'. Do not kill find, diff, sh
|
||||
# and friends, which are also subprocesses of us.
|
||||
foreach (keys %kids) {
|
||||
next unless ($cmdline{$_} =~ /((.|)wine|dosmod)/);
|
||||
# if we have already killed it using -TERM, use -KILL
|
||||
if ($killedalready{$_}) {
|
||||
kill(9,$_); # FIXME: use correct number?
|
||||
} else {
|
||||
kill(15,$_); # FIXME: use correct number?
|
||||
}
|
||||
$killedalready{$_}=1;
|
||||
}
|
||||
alarm($waittime); # wait again...
|
||||
};
|
||||
|
||||
# borrowed from tools/ipcl. See comments there.
|
||||
# killing wine subprocesses unluckily leaves all of their IPC stuff lying
|
||||
# around. We have to wipe it or we run out of it.
|
||||
sub cleanup_wine_ipc {
|
||||
open(IPCS,"ipcs|");
|
||||
while(<IPCS>) {
|
||||
split;
|
||||
# try to find out the IPC-ID, assume it is the first number.
|
||||
foreach (@_) {
|
||||
$_ ne int($_) && next; # not a decimal number
|
||||
$num=$_;
|
||||
last;
|
||||
}
|
||||
# was there before start of this script, skip it.
|
||||
#
|
||||
# FIXME: this doesn't work for programs started during the testrun.
|
||||
#
|
||||
if (/sem/i .. /^\s*$/ ) {
|
||||
index($_,$USER)>=0 || next;
|
||||
push(@sem,$num);
|
||||
}
|
||||
}
|
||||
foreach (@sem) {
|
||||
$sem_used{$_} && next;
|
||||
semctl($_, 0, $IPC_RMID,0);
|
||||
}
|
||||
close(IPCS);
|
||||
}
|
||||
|
||||
# kill all subwineprocesses for automatic runs.
|
||||
sub alarmhandler {
|
||||
print "timer triggered.\n";
|
||||
&kill_subprocesses;
|
||||
}
|
||||
|
||||
$SIG{'ALRM'} = "alarmhandler";
|
||||
|
||||
# NOTE: following find will also cross NFS mounts, so be sure to have nothing
|
||||
# mounted that's not on campus or add relevant ! -fstype nfs or similar.
|
||||
#
|
||||
|
||||
$startdir = '/';
|
||||
|
||||
$startdir = $ARGV[0] if ($ARGV[0] && (-d $ARGV[0]));
|
||||
|
||||
open(FIND,"find $startdir -type f \\( -name \"*.EXE\" -o -name \"*.exe\" -o -name \"*.scr\" -o -name \"*.SCR\" \\) -print|");
|
||||
while ($exe=<FIND>) {
|
||||
chop($exe);
|
||||
|
||||
# This could change during a testrun (by doing 'make' for instance)
|
||||
# FIXME: doesn't handle missing libwine.so during compile...
|
||||
(-x $wine) || die "no $wine executable found!\n";
|
||||
|
||||
# Skip all mssetup, acmsetup , installshield whatever exes.
|
||||
# they seem to work, mostly and starting them is just annoying.
|
||||
next if ($exe =~ /acmsetup|unwise|testexit|_msset|isun|st4u|st5u|_mstest|_isdel|ms-setup|~ms|unin/io);
|
||||
|
||||
$runfile = $exe;
|
||||
$runfile =~ s/[\/ ]/_/g;
|
||||
$runfile =~ s/\.exe$//g;
|
||||
$runfile =~ s/\.scr$//ig;
|
||||
$flag=0;
|
||||
#
|
||||
# Check if changelog is newer, if not, continue
|
||||
#
|
||||
if ( -e "runs/${runfile}.out" &&
|
||||
(-M $changelog > -M "runs/${runfile}.out") &&
|
||||
(-M $exe > -M "runs/${runfile}.out")
|
||||
) {
|
||||
#print "skipping $exe, already done.\n";
|
||||
next;
|
||||
}
|
||||
# now testrun...
|
||||
print "$exe:\n";
|
||||
$dir = $exe;
|
||||
$dir =~ s/^(.*)\/[^\/]*$/$1/; #cut of the basename.
|
||||
|
||||
alarm($waittime);
|
||||
|
||||
chdir($dir)||die "$dir:$!";
|
||||
if ($exe =~ /\.scr/i) {
|
||||
system("echo quit|$wine $wineoptions \"$exe /s\" >$cwd/${runfile}.out 2>&1");
|
||||
} else {
|
||||
system("echo quit|$wine $wineoptions \"$exe\" >$cwd/${runfile}.out 2>&1");
|
||||
}
|
||||
alarm(1000);# so it doesn't trigger in the diff, kill or find.
|
||||
|
||||
system("touch $cwd/runs/${runfile}.out");
|
||||
system("$diff $cwd/runs/${runfile}.out $cwd/${runfile}.out|head -n $trunclines");
|
||||
system("head -n $trunclines $cwd/${runfile}.out >$cwd/runs/${runfile}.out");
|
||||
unlink("$cwd/${runfile}.out");
|
||||
&kill_subprocesses;
|
||||
&cleanup_wine_ipc;
|
||||
chdir($cwd);
|
||||
}
|
||||
close(FIND);
|
||||
Loading…
Reference in New Issue