Strictify tools/testrun
Francois Gouget
fgouget at free.fr
Fri Oct 22 11:25:08 CDT 2004
Is this script still used? Do we want to keep it?
In case the answer is yes I strictified it...
Changelog:
* tools/testrun
Strictified.
Added function prototypes and changed the way we call them so perl
can check the prototypes.
--
Francois Gouget fgouget at free.fr http://fgouget.free.fr/
The software said it requires Win95 or better, so I installed Linux.
-------------- next part --------------
Index: tools/testrun
===================================================================
RCS file: /var/cvs/wine/tools/testrun,v
retrieving revision 1.6
diff -u -r1.6 testrun
--- tools/testrun 21 Oct 2003 23:47:47 -0000 1.6
+++ tools/testrun 19 Oct 2004 18:03:43 -0000
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
# Copyright 1996-1998 Marcus Meissner
# IPC remove code Copyright 1995 Michael Veksler
#
@@ -22,51 +22,55 @@
# 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
+# It only reruns the test if ChangeLog or the executable is NEWER than the
+# run file. (If you want to rerun everything in between releases, touch
# ChangeLog.)
+use strict;
+use Cwd;
+
#
# BEGIN OF USER CONFIGURATION
#
-# Path to WINE executeable. If not specified, 'wine' is searched in the path.
+# Path to WINE executable. If not specified, 'wine' is searched in the path.
#
-$wine = 'wine';
+my $wine = 'wine';
#
-# WINE options. -managed when using a windowmanager is probably not good in
+# WINE options. -managed when using a window manager is probably not good in
# automatic testruns.
#
-$wineoptions='';
+my $wineoptions='';
#
# Path to WINE ChangeLog. Used as timestamp for new releases...
#
-$changelog = '/home/marcus/wine/ChangeLog';
+my $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;
+my $waittime = 50;
#
#diff command
#
-$diff='diff -u';
+my $diff='diff -u';
#
# truncate at how-much-lines
#
-$trunclines=200;
+my $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
#
+my $cwd = getcwd();
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) {
+ my @paths = split(/:/,$ENV{'PATH'});
+ foreach my $path (@paths) {
if (-e "$path/$wine" && -x "$path/$wine") {
$wine = "$path/$wine";
last;
@@ -87,16 +91,15 @@
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'};
+my $IPC_RMID=0;
+my $USER=$ENV{'USER'};
+my %sem_used;
open(IPCS,"ipcs|");
while(<IPCS>) {
- split;
# try to find out the IPC-ID, assume it is the first number.
- foreach (@_) {
+ my $num;
+ foreach (split / +/,$_) {
$_ ne int($_) && next; # not a decimal number
$num=$_;
last;
@@ -109,27 +112,27 @@
}
close(IPCS);
-sub kill_subprocesses {
- local($killedalready,%parentof,%kids,$changed,%cmdline);
+sub kill_subprocesses() {
# 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);
+ my %cmdline;
+ my %parentof=();
+ my $xline = <PSAUX>; # fmtline
+ my @psformat = split(/\s\s*/,$xline);
psline: while (<PSAUX>) {
chop;
- @psline = split(/\s\s*/);
- $pid=0;
- for ($i=0;$i<=$#psformat;$i++) {
+ my @psline = split(/\s\s*/);
+ my $pid=0;
+ for (my $i=0; $i<=$#psformat; $i++) {
if ($psformat[$i] =~ /COMMAND/) {
die unless $pid;
$cmdline{$pid}=$psline[$i];
- break;
+ last;
}
if ($psformat[$i] =~ /PPID/ ) {
$parentof{$pid} = $psline[$i];
@@ -144,9 +147,9 @@
close(PSAUX);
# find out all kids of this perlscript
- %kids = ();
+ my %kids = ();
$kids{$$} = 1;
- $changed = 1;
+ my $changed = 1;
while ($changed) {
$changed = 0;
foreach (keys %parentof) {
@@ -160,7 +163,8 @@
# .. but do not consider us for killing
delete $kids{$$};
# remove all processes killed in the meantime from %killedalready.
- foreach $pid (keys %killedalready) {
+ my %killedalready;
+ foreach my $pid (keys %killedalready) {
delete $killedalready{$pid} if (!$kids{$pid} );
}
# kill all subprocesses called 'wine'. Do not kill find, diff, sh
@@ -181,12 +185,13 @@
# 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 {
+sub cleanup_wine_ipc() {
+ my @sem;
open(IPCS,"ipcs|");
while(<IPCS>) {
- split;
# try to find out the IPC-ID, assume it is the first number.
- foreach (@_) {
+ my $num;
+ foreach (split / +/,$_) {
$_ ne int($_) && next; # not a decimal number
$num=$_;
last;
@@ -208,9 +213,9 @@
}
# kill all subwineprocesses for automatic runs.
-sub alarmhandler {
+sub alarmhandler() {
print "timer triggered.\n";
- &kill_subprocesses;
+ kill_subprocesses();
}
$SIG{'ALRM'} = "alarmhandler";
@@ -219,12 +224,12 @@
# mounted that's not on campus or add relevant ! -fstype nfs or similar.
#
-$startdir = '/';
+my $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>) {
+while (my $exe=<FIND>) {
chop($exe);
# This could change during a testrun (by doing 'make' for instance)
@@ -235,11 +240,11 @@
# 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;
+ my $runfile = $exe;
$runfile =~ s/[\/ ]/_/g;
$runfile =~ s/\.exe$//g;
$runfile =~ s/\.scr$//ig;
- $flag=0;
+ my $flag=0;
#
# Check if changelog is newer, if not, continue
#
@@ -252,7 +257,7 @@
}
# now testrun...
print "$exe:\n";
- $dir = $exe;
+ my $dir = $exe;
$dir =~ s/^(.*)\/[^\/]*$/$1/; #cut of the basename.
alarm($waittime);
@@ -269,8 +274,8 @@
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;
+ kill_subprocesses();
+ cleanup_wine_ipc();
chdir($cwd);
}
close(FIND);
More information about the wine-patches
mailing list