git.oblomov.eu Git - wine/blob - tools/testrun

   1 #!/usr/bin/perl
   2 # Copyright 1996-1998 Marcus Meissner
   3 # IPC remove code Copyright 1995 Michael Veksler
   4 #
   5 # This perl script automatically test runs ALL windows .exe and .scr binaries
   6 # it finds (and can access) on your computer. It creates a subdirectory called
   7 # runs/ and stores the output there. It also does (unique) diffs between runs.
   8 #
   9 # It only reruns the test if ChangeLog or the executeable is NEWER than the
  10 # run file. (If you want to rerun everything inbetween releases, touch
  11 # ChangeLog.)
  12
  13 #
  14 # BEGIN OF USER CONFIGURATION
  15 #
  16 # Path to WINE executeable. If not specified, 'wine' is searched in the path.
  17 #
  18 $wine = 'wine';
  19 #
  20 # WINE options. -managed when using a windowmanager is probably not good in
  21 # automatic testruns.
  22 #
  23 $wineoptions='';
  24 #
  25 # Path to WINE ChangeLog. Used as timestamp for new releases...
  26 #
  27 $changelog = '/home/marcus/wine/ChangeLog';
  28 #
  29 # How long before automatically killing all subprocesses
  30 # 30 is good for automatic testing, 300 or more for interactive testing.
  31 #
  32 $waittime = 30;
  33 #
  34 #diff command
  35 #
  36 $diff='diff -u';
  37 #
  38 # truncate at how-much-lines
  39 #
  40 $trunclines=200;
  41 #
  42 $<||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";
  43 #
  44 # END OF USER CONFIGURATION
  45 #
  46
  47 if (! -d "runs") { die "no subdirectory runs/ found in $cwd. Please create one first!\n";}
  48
  49 # look for the exact path to wine executeable in case we need it for a
  50 # replacement changelog.
  51 if (! ($wine =~ /\//)) { # no path specified. Look it up.
  52         @paths = split(/:/,$ENV{'PATH'});
  53         foreach $path (@paths) {
  54                 if (-e "$path/$wine" && -x "$path/$wine") {
  55                         $wine = "$path/$wine";
  56                         last;
  57                 }
  58         }
  59 }
  60
  61 # if we don't have a changelog use the modification date of the WINE executeable
  62 if (! -e $changelog) {
  63         $changelog = $wine;
  64 }
  65
  66 # sanity check so we just fill runs/ with errors.
  67 (-x $wine)  || die "no $wine executable found!\n";
  68 # dito. will print usage
  69 system("$wine -h >/dev/null")||die "wine call failed:$!\n";
  70
  71 print "Using $wine as WINE executeable.\n";
  72 print "Using $changelog as testrun timereference.\n";
  73
  74 chomp($cwd = `pwd`);
  75
  76 # Find out all present semaphores so we don't remove them later.
  77 $IPC_RMID=0;
  78 $USER=$ENV{'USER'};
  79 open(IPCS,"ipcs|");
  80 while(<IPCS>) {
  81     split;
  82     # try to find out the IPC-ID, assume it is the first number.
  83     foreach (@_) {
  84         $_ ne int($_) && next;  # not a decimal number
  85         $num=$_;
  86         last;
  87     }
  88     if (/sem/i .. /^\s*$/ ) {
  89         index($_,$USER)>=0 || next;
  90         $sem_used{$num}=1;
  91         print "found $num\n";
  92     }
  93 }
  94 close(IPCS);
  95
  96 sub kill_subprocesses {
  97         local($killedalready,%parentof,%kids,$changed,%cmdline);
  98
  99         # FIXME: Linux ps dependend...
 100         #
 101         open(PSAUX,"ps --format pid,ppid,comm|");
 102         # lookup all processes, remember their parents and cmdlines.
 103         %parentof=();
 104         while (<PSAUX>) {
 105                 if (/\s*(\d*)\s*(\d*)\s*(\S*)/) {
 106                         $parentof{$1}=$2;
 107                         $cmdline{$1}=$3;
 108                 }
 109         }
 110         close(PSAUX);
 111
 112         # find out all kids of this perlscript
 113         %kids = ();
 114         $kids{$$} = 1;
 115         $changed = 1;
 116         while ($changed) {
 117                 $changed = 0;
 118                 foreach (keys %parentof) {
 119                         next if ($kids{$_});
 120                         if ($kids{$parentof{$_}}) {
 121                                 $changed = 1;
 122                                 $kids{$_}=1;
 123                         }
 124                 }
 125         }
 126         # .. but do not consider us for killing
 127         delete $kids{$$};
 128         # remove all processes killed in the meantime from %killedalready.
 129         foreach $pid (keys %killedalready) {
 130                 delete $killedalready{$pid} if (!$kids{$pid} );
 131         }
 132         # kill all subprocesses called 'wine'. Do not kill find, diff, sh
 133         # and friends, which are also subprocesses of us.
 134         foreach (keys %kids) {
 135                 next unless ($cmdline{$_} =~ /wine/);
 136                 # if we have already killed it using -TERM, use -KILL
 137                 if ($killedalready{$_}) {
 138                         kill(9,$_);     # FIXME: use correct number?
 139                 } else {
 140                         kill(15,$_);    # FIXME: use correct number?
 141                 }
 142                 $killedalready{$_}=1;
 143         }
 144         alarm($waittime);               # wait again...
 145 };
 146
 147 # borrowed from tools/ipcl. See comments there.
 148 # killing wine subprocesses unluckily leaves all of their IPC stuff lying
 149 # around. We have to wipe it or we run out of it.
 150 sub cleanup_wine_ipc {
 151         open(IPCS,"ipcs|");
 152         while(<IPCS>) {
 153             split;
 154             # try to find out the IPC-ID, assume it is the first number.
 155             foreach (@_) {
 156                 $_ ne int($_) && next;  # not a decimal number
 157                 $num=$_;
 158                 last;
 159             }
 160             # was there before start of this script, skip it.
 161             #
 162             # FIXME: this doesn't work for programs started during the testrun.
 163             #
 164             if (/sem/i .. /^\s*$/ ) {
 165                 index($_,$USER)>=0 || next;
 166                 push(@sem,$num);
 167             }
 168         }
 169         foreach (@sem) {
 170             $sem_used{$_} && next;
 171             semctl($_, 0, $IPC_RMID,0);
 172         }
 173         close(IPCS);
 174 }
 175
 176 # kill all subwineprocesses for automatic runs.
 177 sub alarmhandler {
 178         print "timer triggered.\n";
 179         &kill_subprocesses;
 180 }
 181
 182 $SIG{'ALRM'} = "alarmhandler";
 183
 184 # NOTE: following find will also cross NFS mounts, so be sure to have nothing
 185 # mounted that's not on campus or add relevant ! -fstype nfs or similar.
 186 #
 187
 188 open(FIND,"find / -type f  \\( -name \"*.EXE\" -o -name \"*.exe\" -o -name \"*.scr\" -o -name \"*.SCR\" \\) -print|");
 189 while ($exe=<FIND>) {
 190         chop($exe);
 191
 192         # This could change during a testrun (by doing 'make' for instance)
 193         # FIXME: doesn't handle missing libwine.so during compile...
 194         (-x $wine)  || die "no $wine executable found!\n";
 195
 196         # Skip all mssetup, acmsetup , installshield whatever exes.
 197         # they seem to work, mostly and starting them is just annoying.
 198         next if ($exe =~ /acmsetup/);
 199         next if ($exe =~ /unwise/);
 200         next if ($exe =~ /testexit/);
 201         next if ($exe =~ /_msset/);
 202         next if ($exe =~ /isun/i);
 203         next if ($exe =~ /st4u/);
 204         next if ($exe =~ /st5u/);
 205         next if ($exe =~ /_mstest/);
 206         next if ($exe =~ /_isdel/);
 207         next if ($exe =~ /ms-setup/);
 208         next if ($exe =~ /~mss/);
 209         next if ($exe =~ /unin/);
 210
 211         $runfile = $exe;
 212         $runfile =~ s/[\/ ]/_/g;
 213         $runfile =~ s/\.exe$//g;
 214         $runfile =~ s/\.scr$//ig;
 215         $flag=0;
 216         #
 217         # Check if changelog is newer, if not, continue
 218         #
 219         if (    -e "runs/${runfile}.out" &&
 220                 (-M $changelog > -M "runs/${runfile}.out") &&
 221                 (-M $exe > -M "runs/${runfile}.out")
 222         ) {
 223                 #print "skipping $exe, already done.\n";
 224                 next;
 225         }
 226
 227         # check runfile if the exe is a DOS executeable or
 228         # of different architecture (win32)
 229         if (open(RUNFILE,"runs/$runfile.out")) {
 230                 while ($xrun=<RUNFILE>) {
 231                         chop($xrun);
 232                         if ($xrun=~ /LoadModule:.*error=11$/) {
 233                                 $flag=1;
 234                                 last;
 235                         }
 236                         if ($xrun=~ /LoadModule:.*error=21$/) {
 237                                 $flag=2;
 238                                 last;
 239                         }
 240                 }
 241                 close(RUNFILE);
 242                 if ($flag==1) {
 243                         #print "skipping $exe, seems to be a DOS executable.\n";
 244                         next;
 245                 }
 246                 if ($flag==2) {
 247                         #print "skipping $exe, seems to be a non i386 executable.\n";
 248                         next;
 249                 }
 250         }
 251         # now testrun...
 252         print "$exe:\n";
 253         $dir = $exe;
 254         $dir =~ s/^(.*)\/[^\/]*$/$1/; #cut of the basename.
 255
 256         alarm($waittime);
 257
 258         chdir($dir)||die "$dir:$!";
 259         if ($exe =~ /\.scr/i) {
 260                 system("echo quit|$wine $wineoptions \"$exe /s\" >$cwd/${runfile}.out 2>&1");
 261         } else {
 262                 system("echo quit|$wine $wineoptions \"$exe\" >$cwd/${runfile}.out 2>&1");
 263         }
 264         alarm(1000);# so it doesn't trigger in the diff, kill or find.
 265
 266         system("touch $cwd/runs/${runfile}.out");
 267         system("$diff $cwd/runs/${runfile}.out $cwd/${runfile}.out");
 268         system("head -$trunclines $cwd/${runfile}.out >$cwd/runs/${runfile}.out");
 269         unlink("$cwd/${runfile}.out");
 270         &kill_subprocesses;
 271         &cleanup_wine_ipc;
 272         chdir($cwd);
 273 }
 274 close(FIND);