1178536Sjb#!/usr/local/bin/perl 2178476Sjb# 3178476Sjb# CDDL HEADER START 4178476Sjb# 5178476Sjb# The contents of this file are subject to the terms of the 6178476Sjb# Common Development and Distribution License (the "License"). 7178476Sjb# You may not use this file except in compliance with the License. 8178476Sjb# 9178476Sjb# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 10178476Sjb# or http://www.opensolaris.org/os/licensing. 11178476Sjb# See the License for the specific language governing permissions 12178476Sjb# and limitations under the License. 13178476Sjb# 14178476Sjb# When distributing Covered Code, include this CDDL HEADER in each 15178476Sjb# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 16178476Sjb# If applicable, add the following below this CDDL HEADER, with the 17178476Sjb# fields enclosed by brackets "[]" replaced with your own identifying 18178476Sjb# information: Portions Copyright [yyyy] [name of copyright owner] 19178476Sjb# 20178476Sjb# CDDL HEADER END 21178476Sjb# 22178476Sjb 23178476Sjb# 24178476Sjb# Copyright 2008 Sun Microsystems, Inc. All rights reserved. 25178476Sjb# Use is subject to license terms. 26178476Sjb# 27178476Sjb 28210767Srpaulorequire 5.8.4; 29178476Sjb 30178476Sjbuse File::Find; 31178476Sjbuse File::Basename; 32178476Sjbuse Getopt::Std; 33178476Sjbuse Cwd; 34178476Sjbuse Cwd 'abs_path'; 35178476Sjb 36178476Sjb$PNAME = $0; 37178476Sjb$PNAME =~ s:.*/::; 38178476Sjb$OPTSTR = 'abd:fghi:jlnqsx:'; 39178476Sjb$USAGE = "Usage: $PNAME [-abfghjlnqs] [-d dir] [-i isa] " 40178476Sjb . "[-x opt[=arg]] [file | dir ...]\n"; 41178476Sjb($MACH = `uname -p`) =~ s/\W*\n//; 42210767Srpaulo($PLATFORM = `uname -i`) =~ s/\W*\n//; 43178476Sjb 44178476Sjb@dtrace_argv = (); 45178476Sjb 46211545Srpaulo$ksh_path = '/usr/local/bin/ksh'; 47178476Sjb 48178476Sjb@files = (); 49178476Sjb%exceptions = (); 50178476Sjb%results = (); 51178476Sjb$errs = 0; 52178476Sjb 53178476Sjb# 54178476Sjb# If no test files are specified on the command-line, execute a find on "." 55178476Sjb# and append any tst.*.d, tst.*.ksh, err.*.d or drp.*.d files found within 56178476Sjb# the directory tree. 57178476Sjb# 58178476Sjbsub wanted 59178476Sjb{ 60178476Sjb push(@files, $File::Find::name) 61178476Sjb if ($_ =~ /^(tst|err|drp)\..+\.(d|ksh)$/ && -f "$_"); 62178476Sjb} 63178476Sjb 64178476Sjbsub dirname { 65178476Sjb my($s) = @_; 66178476Sjb my($i); 67178476Sjb 68178476Sjb $s = substr($s, 0, $i) if (($i = rindex($s, '/')) != -1); 69178476Sjb return $i == -1 ? '.' : $i == 0 ? '/' : $s; 70178476Sjb} 71178476Sjb 72178476Sjbsub usage 73178476Sjb{ 74178476Sjb print $USAGE; 75178476Sjb print "\t -a execute test suite using anonymous enablings\n"; 76178476Sjb print "\t -b execute bad ioctl test program\n"; 77178476Sjb print "\t -d specify directory for test results files and cores\n"; 78178476Sjb print "\t -g enable libumem debugging when running tests\n"; 79178476Sjb print "\t -f force bypassed tests to run\n"; 80178476Sjb print "\t -h display verbose usage message\n"; 81178476Sjb print "\t -i specify ISA to test instead of isaexec(3C) default\n"; 82178476Sjb print "\t -j execute test suite using jdtrace (Java API) only\n"; 83178476Sjb print "\t -l save log file of results and PIDs used by tests\n"; 84178476Sjb print "\t -n execute test suite using dtrace(1m) only\n"; 85178476Sjb print "\t -q set quiet mode (only report errors and summary)\n"; 86178476Sjb print "\t -s save results files even for tests that pass\n"; 87178476Sjb print "\t -x pass corresponding -x argument to dtrace(1M)\n"; 88178476Sjb exit(2); 89178476Sjb} 90178476Sjb 91178476Sjbsub errmsg 92178476Sjb{ 93178476Sjb my($msg) = @_; 94178476Sjb 95178476Sjb print STDERR $msg; 96178476Sjb print LOG $msg if ($opt_l); 97178476Sjb $errs++; 98178476Sjb} 99178476Sjb 100178476Sjbsub fail 101178476Sjb{ 102178476Sjb my(@parms) = @_; 103178476Sjb my($msg) = $parms[0]; 104178476Sjb my($errfile) = $parms[1]; 105178476Sjb my($n) = 0; 106178476Sjb my($dest) = basename($file); 107178476Sjb 108178476Sjb while (-d "$opt_d/failure.$n") { 109178476Sjb $n++; 110178476Sjb } 111178476Sjb 112178476Sjb unless (mkdir "$opt_d/failure.$n") { 113178476Sjb warn "ERROR: failed to make directory $opt_d/failure.$n: $!\n"; 114178476Sjb exit(125); 115178476Sjb } 116178476Sjb 117178476Sjb open(README, ">$opt_d/failure.$n/README"); 118178476Sjb print README "ERROR: " . $file . " " . $msg; 119178476Sjb 120178476Sjb if (scalar @parms > 1) { 121178476Sjb print README "; see $errfile\n"; 122178476Sjb } else { 123178476Sjb if (-f "$opt_d/$pid.core") { 124178476Sjb print README "; see $pid.core\n"; 125178476Sjb } else { 126178476Sjb print README "\n"; 127178476Sjb } 128178476Sjb } 129178476Sjb 130178476Sjb close(README); 131178476Sjb 132178476Sjb if (-f "$opt_d/$pid.out") { 133178476Sjb rename("$opt_d/$pid.out", "$opt_d/failure.$n/$pid.out"); 134178476Sjb link("$file.out", "$opt_d/failure.$n/$dest.out"); 135178476Sjb } 136178476Sjb 137178476Sjb if (-f "$opt_d/$pid.err") { 138178476Sjb rename("$opt_d/$pid.err", "$opt_d/failure.$n/$pid.err"); 139178476Sjb link("$file.err", "$opt_d/failure.$n/$dest.err"); 140178476Sjb } 141178476Sjb 142178476Sjb if (-f "$opt_d/$pid.core") { 143178476Sjb rename("$opt_d/$pid.core", "$opt_d/failure.$n/$pid.core"); 144178476Sjb } 145178476Sjb 146178476Sjb link("$file", "$opt_d/failure.$n/$dest"); 147178476Sjb 148178476Sjb $msg = "ERROR: " . $dest . " " . $msg; 149178476Sjb 150178476Sjb if (scalar @parms > 1) { 151178476Sjb $msg = $msg . "; see $errfile in failure.$n\n"; 152178476Sjb } else { 153178476Sjb $msg = $msg . "; details in failure.$n\n"; 154178476Sjb } 155178476Sjb 156178476Sjb errmsg($msg); 157178476Sjb} 158178476Sjb 159178476Sjbsub logmsg 160178476Sjb{ 161178476Sjb my($msg) = @_; 162178476Sjb 163178476Sjb print STDOUT $msg unless ($opt_q); 164178476Sjb print LOG $msg if ($opt_l); 165178476Sjb} 166178476Sjb 167178476Sjb# Trim leading and trailing whitespace 168178476Sjbsub trim { 169178476Sjb my($s) = @_; 170178476Sjb 171178476Sjb $s =~ s/^\s*//; 172178476Sjb $s =~ s/\s*$//; 173178476Sjb return $s; 174178476Sjb} 175178476Sjb 176178476Sjb# Load exception set of skipped tests from the file at the given 177178476Sjb# pathname. The test names are assumed to be paths relative to $dt_tst, 178178476Sjb# for example: common/aggs/tst.neglquant.d, and specify tests to be 179178476Sjb# skipped. 180178476Sjbsub load_exceptions { 181178476Sjb my($listfile) = @_; 182178476Sjb my($line) = ""; 183178476Sjb 184178476Sjb %exceptions = (); 185178476Sjb if (length($listfile) > 0) { 186178476Sjb exit(123) unless open(STDIN, "<$listfile"); 187178476Sjb while (<STDIN>) { 188178476Sjb chomp; 189178476Sjb $line = $_; 190178476Sjb # line is non-empty and not a comment 191178476Sjb if ((length($line) > 0) && ($line =~ /^\s*[^\s#]/ )) { 192178476Sjb $exceptions{trim($line)} = 1; 193178476Sjb } 194178476Sjb } 195178476Sjb } 196178476Sjb} 197178476Sjb 198178476Sjb# Return 1 if the test is found in the exception set, 0 otherwise. 199178476Sjbsub is_exception { 200178476Sjb my($file) = @_; 201178476Sjb my($i) = -1; 202178476Sjb 203178476Sjb if (scalar(keys(%exceptions)) == 0) { 204178476Sjb return 0; 205178476Sjb } 206178476Sjb 207178476Sjb # hash absolute pathname after $dt_tst/ 208178476Sjb $file = abs_path($file); 209178476Sjb $i = index($file, $dt_tst); 210178476Sjb if ($i == 0) { 211178476Sjb $file = substr($file, length($dt_tst) + 1); 212178476Sjb return $exceptions{$file}; 213178476Sjb } 214178476Sjb return 0; 215178476Sjb} 216178476Sjb 217178476Sjb# 218210767Srpaulo# Iterate over the set of test files specified on the command-line or by a find 219210767Srpaulo# on "$defdir/common", "$defdir/$MACH" and "$defdir/$PLATFORM" and execute each 220210767Srpaulo# one. If the test file is executable, we fork and exec it. If the test is a 221210767Srpaulo# .ksh file, we run it with $ksh_path. Otherwise we run dtrace -s on it. If 222210767Srpaulo# the file is named tst.* we assume it should return exit status 0. If the 223210767Srpaulo# file is named err.* we assume it should return exit status 1. If the file is 224210767Srpaulo# named err.D_[A-Z0-9]+[.*].d we use dtrace -xerrtags and examine stderr to 225210767Srpaulo# ensure that a matching error tag was produced. If the file is named 226210767Srpaulo# drp.[A-Z0-9]+[.*].d we use dtrace -xdroptags and examine stderr to ensure 227210767Srpaulo# that a matching drop tag was produced. If any *.out or *.err files are found 228210767Srpaulo# we perform output comparisons. 229178476Sjb# 230178476Sjb# run_tests takes two arguments: The first is the pathname of the dtrace 231178476Sjb# command to invoke when running the tests. The second is the pathname 232178476Sjb# of a file (may be the empty string) listing tests that ought to be 233178476Sjb# skipped (skipped tests are listed as paths relative to $dt_tst, for 234178476Sjb# example: common/aggs/tst.neglquant.d). 235178476Sjb# 236178476Sjbsub run_tests { 237178476Sjb my($dtrace, $exceptions_path) = @_; 238178476Sjb my($passed) = 0; 239178476Sjb my($bypassed) = 0; 240178476Sjb my($failed) = $errs; 241178476Sjb my($total) = 0; 242178476Sjb 243178476Sjb die "$PNAME: $dtrace not found\n" unless (-x "$dtrace"); 244178476Sjb logmsg($dtrace . "\n"); 245178476Sjb 246178476Sjb load_exceptions($exceptions_path); 247178476Sjb 248178476Sjb foreach $file (sort @files) { 249178476Sjb $file =~ m:.*/((.*)\.(\w+)):; 250178476Sjb $name = $1; 251178476Sjb $base = $2; 252178476Sjb $ext = $3; 253178476Sjb 254178476Sjb $dir = dirname($file); 255178476Sjb $isksh = 0; 256178476Sjb $tag = 0; 257178476Sjb $droptag = 0; 258178476Sjb 259178476Sjb if ($name =~ /^tst\./) { 260178476Sjb $isksh = ($ext eq 'ksh'); 261178476Sjb $status = 0; 262178476Sjb } elsif ($name =~ /^err\.(D_[A-Z0-9_]+)\./) { 263178476Sjb $status = 1; 264178476Sjb $tag = $1; 265178476Sjb } elsif ($name =~ /^err\./) { 266178476Sjb $status = 1; 267178476Sjb } elsif ($name =~ /^drp\.([A-Z0-9_]+)\./) { 268178476Sjb $status = 0; 269178476Sjb $droptag = $1; 270178476Sjb } else { 271178476Sjb errmsg("ERROR: $file is not a valid test file name\n"); 272178476Sjb next; 273178476Sjb } 274178476Sjb 275178476Sjb $fullname = "$dir/$name"; 276178536Sjb $exe = "./$base.exe"; 277178476Sjb $exe_pid = -1; 278178476Sjb 279178476Sjb if ($opt_a && ($status != 0 || $tag != 0 || $droptag != 0 || 280178476Sjb -x $exe || $isksh || -x $fullname)) { 281178476Sjb $bypassed++; 282178476Sjb next; 283178476Sjb } 284178476Sjb 285178476Sjb if (!$opt_f && is_exception("$dir/$name")) { 286178476Sjb $bypassed++; 287178476Sjb next; 288178476Sjb } 289178476Sjb 290178476Sjb if (!$isksh && -x $exe) { 291178476Sjb if (($exe_pid = fork()) == -1) { 292178476Sjb errmsg( 293178476Sjb "ERROR: failed to fork to run $exe: $!\n"); 294178476Sjb next; 295178476Sjb } 296178476Sjb 297178476Sjb if ($exe_pid == 0) { 298178476Sjb open(STDIN, '</dev/null'); 299178476Sjb 300178476Sjb exec($exe); 301178476Sjb 302178476Sjb warn "ERROR: failed to exec $exe: $!\n"; 303178476Sjb } 304178476Sjb } 305178476Sjb 306178476Sjb logmsg("testing $file ... "); 307178476Sjb 308178476Sjb if (($pid = fork()) == -1) { 309178476Sjb errmsg("ERROR: failed to fork to run test $file: $!\n"); 310178476Sjb next; 311178476Sjb } 312178476Sjb 313178476Sjb if ($pid == 0) { 314178476Sjb open(STDIN, '</dev/null'); 315178476Sjb exit(125) unless open(STDOUT, ">$opt_d/$$.out"); 316178476Sjb exit(125) unless open(STDERR, ">$opt_d/$$.err"); 317178476Sjb 318178476Sjb unless (chdir($dir)) { 319178476Sjb warn "ERROR: failed to chdir for $file: $!\n"; 320178476Sjb exit(126); 321178476Sjb } 322178476Sjb 323178476Sjb push(@dtrace_argv, '-xerrtags') if ($tag); 324178476Sjb push(@dtrace_argv, '-xdroptags') if ($droptag); 325178476Sjb push(@dtrace_argv, $exe_pid) if ($exe_pid != -1); 326178476Sjb 327178476Sjb if ($isksh) { 328178476Sjb exit(123) unless open(STDIN, "<$name"); 329178476Sjb exec("$ksh_path /dev/stdin $dtrace"); 330178476Sjb } elsif (-x $name) { 331178476Sjb warn "ERROR: $name is executable\n"; 332178476Sjb exit(1); 333178476Sjb } else { 334178476Sjb if ($tag == 0 && $status == $0 && $opt_a) { 335178476Sjb push(@dtrace_argv, '-A'); 336178476Sjb } 337178476Sjb 338178476Sjb push(@dtrace_argv, '-C'); 339178476Sjb push(@dtrace_argv, '-s'); 340178476Sjb push(@dtrace_argv, $name); 341178476Sjb exec($dtrace, @dtrace_argv); 342178476Sjb } 343178476Sjb 344178476Sjb warn "ERROR: failed to exec for $file: $!\n"; 345178476Sjb exit(127); 346178476Sjb } 347178476Sjb 348178476Sjb if (waitpid($pid, 0) == -1) { 349178476Sjb errmsg("ERROR: timed out waiting for $file\n"); 350178476Sjb kill(9, $exe_pid) if ($exe_pid != -1); 351178476Sjb kill(9, $pid); 352178476Sjb next; 353178476Sjb } 354178476Sjb 355178476Sjb kill(9, $exe_pid) if ($exe_pid != -1); 356178476Sjb 357178476Sjb if ($tag == 0 && $status == $0 && $opt_a) { 358178476Sjb # 359178476Sjb # We can chuck the earler output. 360178476Sjb # 361178476Sjb unlink($pid . '.out'); 362178476Sjb unlink($pid . '.err'); 363178476Sjb 364178476Sjb # 365178476Sjb # This is an anonymous enabling. We need to get 366178476Sjb # the module unloaded. 367178476Sjb # 368178476Sjb system("dtrace -ae 1> /dev/null 2> /dev/null"); 369178476Sjb system("svcadm disable -s " . 370178476Sjb "svc:/network/nfs/mapid:default"); 371178476Sjb system("modunload -i 0 ; modunload -i 0 ; " . 372178476Sjb "modunload -i 0"); 373178476Sjb if (!system("modinfo | grep dtrace")) { 374178476Sjb warn "ERROR: couldn't unload dtrace\n"; 375178476Sjb system("svcadm enable " . 376178476Sjb "-s svc:/network/nfs/mapid:default"); 377178476Sjb exit(124); 378178476Sjb } 379178476Sjb 380178476Sjb # 381178476Sjb # DTrace is gone. Now update_drv(1M), and rip 382178476Sjb # everything out again. 383178476Sjb # 384178476Sjb system("update_drv dtrace"); 385178476Sjb system("dtrace -ae 1> /dev/null 2> /dev/null"); 386178476Sjb system("modunload -i 0 ; modunload -i 0 ; " . 387178476Sjb "modunload -i 0"); 388178476Sjb if (!system("modinfo | grep dtrace")) { 389178476Sjb warn "ERROR: couldn't unload dtrace\n"; 390178476Sjb system("svcadm enable " . 391178476Sjb "-s svc:/network/nfs/mapid:default"); 392178476Sjb exit(124); 393178476Sjb } 394178476Sjb 395178476Sjb # 396178476Sjb # Now bring DTrace back in. 397178476Sjb # 398178476Sjb system("sync ; sync"); 399178476Sjb system("dtrace -l -n bogusprobe 1> /dev/null " . 400178476Sjb "2> /dev/null"); 401178476Sjb system("svcadm enable -s " . 402178476Sjb "svc:/network/nfs/mapid:default"); 403178476Sjb 404178476Sjb # 405178476Sjb # That should have caused DTrace to reload with 406178476Sjb # the new configuration file. Now we can try to 407178476Sjb # snag our anonymous state. 408178476Sjb # 409178476Sjb if (($pid = fork()) == -1) { 410178476Sjb errmsg("ERROR: failed to fork to run " . 411178476Sjb "test $file: $!\n"); 412178476Sjb next; 413178476Sjb } 414178476Sjb 415178476Sjb if ($pid == 0) { 416178476Sjb open(STDIN, '</dev/null'); 417178476Sjb exit(125) unless open(STDOUT, ">$opt_d/$$.out"); 418178476Sjb exit(125) unless open(STDERR, ">$opt_d/$$.err"); 419178476Sjb 420178476Sjb push(@dtrace_argv, '-a'); 421178476Sjb 422178476Sjb unless (chdir($dir)) { 423178476Sjb warn "ERROR: failed to chdir " . 424178476Sjb "for $file: $!\n"; 425178476Sjb exit(126); 426178476Sjb } 427178476Sjb 428178476Sjb exec($dtrace, @dtrace_argv); 429178476Sjb warn "ERROR: failed to exec for $file: $!\n"; 430178476Sjb exit(127); 431178476Sjb } 432178476Sjb 433178476Sjb if (waitpid($pid, 0) == -1) { 434178476Sjb errmsg("ERROR: timed out waiting for $file\n"); 435178476Sjb kill(9, $pid); 436178476Sjb next; 437178476Sjb } 438178476Sjb } 439178476Sjb 440178476Sjb logmsg("[$pid]\n"); 441178476Sjb $wstat = $?; 442178476Sjb $wifexited = ($wstat & 0xFF) == 0; 443178476Sjb $wexitstat = ($wstat >> 8) & 0xFF; 444178476Sjb $wtermsig = ($wstat & 0x7F); 445178476Sjb 446178476Sjb if (!$wifexited) { 447178476Sjb fail("died from signal $wtermsig"); 448178476Sjb next; 449178476Sjb } 450178476Sjb 451178476Sjb if ($wexitstat == 125) { 452178476Sjb die "$PNAME: failed to create output file in $opt_d " . 453178476Sjb "(cd elsewhere or use -d)\n"; 454178476Sjb } 455178476Sjb 456178476Sjb if ($wexitstat != $status) { 457178476Sjb fail("returned $wexitstat instead of $status"); 458178476Sjb next; 459178476Sjb } 460178476Sjb 461178476Sjb if (-f "$file.out" && 462178476Sjb system("cmp -s $file.out $opt_d/$pid.out") != 0) { 463178476Sjb fail("stdout mismatch", "$pid.out"); 464178476Sjb next; 465178476Sjb } 466178476Sjb 467178476Sjb if (-f "$file.err" && 468178476Sjb system("cmp -s $file.err $opt_d/$pid.err") != 0) { 469178476Sjb fail("stderr mismatch: see $pid.err"); 470178476Sjb next; 471178476Sjb } 472178476Sjb 473178476Sjb if ($tag) { 474178476Sjb open(TSTERR, "<$opt_d/$pid.err"); 475178476Sjb $tsterr = <TSTERR>; 476178476Sjb close(TSTERR); 477178476Sjb 478178476Sjb unless ($tsterr =~ /: \[$tag\] line \d+:/) { 479178476Sjb fail("errtag mismatch: see $pid.err"); 480178476Sjb next; 481178476Sjb } 482178476Sjb } 483178476Sjb 484178476Sjb if ($droptag) { 485178476Sjb $found = 0; 486178476Sjb open(TSTERR, "<$opt_d/$pid.err"); 487178476Sjb 488178476Sjb while (<TSTERR>) { 489178476Sjb if (/\[$droptag\] /) { 490178476Sjb $found = 1; 491178476Sjb last; 492178476Sjb } 493178476Sjb } 494178476Sjb 495178476Sjb close (TSTERR); 496178476Sjb 497178476Sjb unless ($found) { 498178476Sjb fail("droptag mismatch: see $pid.err"); 499178476Sjb next; 500178476Sjb } 501178476Sjb } 502178476Sjb 503178476Sjb unless ($opt_s) { 504178476Sjb unlink($pid . '.out'); 505178476Sjb unlink($pid . '.err'); 506178476Sjb } 507178476Sjb } 508178476Sjb 509178476Sjb if ($opt_a) { 510178476Sjb # 511178476Sjb # If we're running with anonymous enablings, we need to 512178476Sjb # restore the .conf file. 513178476Sjb # 514178476Sjb system("dtrace -A 1> /dev/null 2> /dev/null"); 515178476Sjb system("dtrace -ae 1> /dev/null 2> /dev/null"); 516178476Sjb system("modunload -i 0 ; modunload -i 0 ; modunload -i 0"); 517178476Sjb system("update_drv dtrace"); 518178476Sjb } 519178476Sjb 520178476Sjb $total = scalar(@files); 521178476Sjb $failed = $errs - $failed; 522178476Sjb $passed = ($total - $failed - $bypassed); 523178476Sjb $results{$dtrace} = { 524178476Sjb "passed" => $passed, 525178476Sjb "bypassed" => $bypassed, 526178476Sjb "failed" => $failed, 527178476Sjb "total" => $total 528178476Sjb }; 529178476Sjb} 530178476Sjb 531178476Sjbdie $USAGE unless (getopts($OPTSTR)); 532178476Sjbusage() if ($opt_h); 533178476Sjb 534178476Sjbforeach $arg (@ARGV) { 535178476Sjb if (-f $arg) { 536178476Sjb push(@files, $arg); 537178476Sjb } elsif (-d $arg) { 538178476Sjb find(\&wanted, $arg); 539178476Sjb } else { 540178476Sjb die "$PNAME: $arg is not a valid file or directory\n"; 541178476Sjb } 542178476Sjb} 543178476Sjb 544178476Sjb$dt_tst = '/opt/SUNWdtrt/tst'; 545178476Sjb$dt_bin = '/opt/SUNWdtrt/bin'; 546178476Sjb$defdir = -d $dt_tst ? $dt_tst : '.'; 547178476Sjb$bindir = -d $dt_bin ? $dt_bin : '.'; 548178476Sjb 549178476Sjbfind(\&wanted, "$defdir/common") if (scalar(@ARGV) == 0); 550178476Sjbfind(\&wanted, "$defdir/$MACH") if (scalar(@ARGV) == 0); 551210767Srpaulofind(\&wanted, "$defdir/$PLATFORM") if (scalar(@ARGV) == 0); 552178476Sjbdie $USAGE if (scalar(@files) == 0); 553178476Sjb 554178476Sjb$dtrace_path = '/usr/sbin/dtrace'; 555178476Sjb$jdtrace_path = "$bindir/jdtrace"; 556178476Sjb 557178476Sjb%exception_lists = ("$jdtrace_path" => "$bindir/exception.lst"); 558178476Sjb 559178476Sjbif ($opt_j || $opt_n || $opt_i) { 560178476Sjb @dtrace_cmds = (); 561178476Sjb push(@dtrace_cmds, $dtrace_path) if ($opt_n); 562178476Sjb push(@dtrace_cmds, $jdtrace_path) if ($opt_j); 563178476Sjb push(@dtrace_cmds, "/usr/sbin/$opt_i/dtrace") if ($opt_i); 564178476Sjb} else { 565178476Sjb @dtrace_cmds = ($dtrace_path, $jdtrace_path); 566178476Sjb} 567178476Sjb 568178476Sjbif ($opt_d) { 569178476Sjb die "$PNAME: -d arg must be absolute path\n" unless ($opt_d =~ /^\//); 570178476Sjb die "$PNAME: -d arg $opt_d is not a directory\n" unless (-d "$opt_d"); 571178476Sjb system("coreadm -p $opt_d/%p.core"); 572178476Sjb} else { 573178476Sjb my $dir = getcwd; 574178476Sjb system("coreadm -p $dir/%p.core"); 575178476Sjb $opt_d = '.'; 576178476Sjb} 577178476Sjb 578178476Sjbif ($opt_x) { 579178476Sjb push(@dtrace_argv, '-x'); 580178476Sjb push(@dtrace_argv, $opt_x); 581178476Sjb} 582178476Sjb 583178476Sjbdie "$PNAME: failed to open $PNAME.$$.log: $!\n" 584178476Sjb unless (!$opt_l || open(LOG, ">$PNAME.$$.log")); 585178476Sjb 586253725Spfg$ENV{'DTRACE_DEBUG_REGSET'} = 'true'; 587253725Spfg 588178476Sjbif ($opt_g) { 589178476Sjb $ENV{'UMEM_DEBUG'} = 'default,verbose'; 590178476Sjb $ENV{'UMEM_LOGGING'} = 'fail,contents'; 591178476Sjb $ENV{'LD_PRELOAD'} = 'libumem.so'; 592178476Sjb} 593178476Sjb 594178476Sjb# 595178476Sjb# Ensure that $PATH contains a cc(1) so that we can execute the 596178476Sjb# test programs that require compilation of C code. 597178476Sjb# 598178536Sjb#$ENV{'PATH'} = $ENV{'PATH'} . ':/ws/onnv-tools/SUNWspro/SS11/bin'; 599178476Sjb 600178476Sjbif ($opt_b) { 601178476Sjb logmsg("badioctl'ing ... "); 602178476Sjb 603178476Sjb if (($badioctl = fork()) == -1) { 604178476Sjb errmsg("ERROR: failed to fork to run badioctl: $!\n"); 605178476Sjb next; 606178476Sjb } 607178476Sjb 608178476Sjb if ($badioctl == 0) { 609178476Sjb open(STDIN, '</dev/null'); 610178476Sjb exit(125) unless open(STDOUT, ">$opt_d/$$.out"); 611178476Sjb exit(125) unless open(STDERR, ">$opt_d/$$.err"); 612178476Sjb 613178476Sjb exec($bindir . "/badioctl"); 614178476Sjb warn "ERROR: failed to exec badioctl: $!\n"; 615178476Sjb exit(127); 616178476Sjb } 617178476Sjb 618178476Sjb 619178476Sjb logmsg("[$badioctl]\n"); 620178476Sjb 621178476Sjb # 622178476Sjb # If we're going to be bad, we're just going to iterate over each 623178476Sjb # test file. 624178476Sjb # 625178476Sjb foreach $file (sort @files) { 626178476Sjb ($name = $file) =~ s:.*/::; 627178476Sjb $dir = dirname($file); 628178476Sjb 629178476Sjb if (!($name =~ /^tst\./ && $name =~ /\.d$/)) { 630178476Sjb next; 631178476Sjb } 632178476Sjb 633178476Sjb logmsg("baddof'ing $file ... "); 634178476Sjb 635178476Sjb if (($pid = fork()) == -1) { 636178476Sjb errmsg("ERROR: failed to fork to run baddof: $!\n"); 637178476Sjb next; 638178476Sjb } 639178476Sjb 640178476Sjb if ($pid == 0) { 641178476Sjb open(STDIN, '</dev/null'); 642178476Sjb exit(125) unless open(STDOUT, ">$opt_d/$$.out"); 643178476Sjb exit(125) unless open(STDERR, ">$opt_d/$$.err"); 644178476Sjb 645178476Sjb unless (chdir($dir)) { 646178476Sjb warn "ERROR: failed to chdir for $file: $!\n"; 647178476Sjb exit(126); 648178476Sjb } 649178476Sjb 650178476Sjb exec($bindir . "/baddof", $name); 651178476Sjb 652178476Sjb warn "ERROR: failed to exec for $file: $!\n"; 653178476Sjb exit(127); 654178476Sjb } 655178476Sjb 656178476Sjb sleep 60; 657178476Sjb kill(9, $pid); 658178476Sjb waitpid($pid, 0); 659178476Sjb 660178476Sjb logmsg("[$pid]\n"); 661178476Sjb 662178476Sjb unless ($opt_s) { 663178476Sjb unlink($pid . '.out'); 664178476Sjb unlink($pid . '.err'); 665178476Sjb } 666178476Sjb } 667178476Sjb 668178476Sjb kill(9, $badioctl); 669178476Sjb waitpid($badioctl, 0); 670178476Sjb 671178476Sjb unless ($opt_s) { 672178476Sjb unlink($badioctl . '.out'); 673178476Sjb unlink($badioctl . '.err'); 674178476Sjb } 675178476Sjb 676178476Sjb exit(0); 677178476Sjb} 678178476Sjb 679178476Sjb# 680178476Sjb# Run all the tests specified on the command-line (the entire test suite 681178476Sjb# by default) once for each dtrace command tested, skipping any tests 682178476Sjb# not valid for that command. 683178476Sjb# 684178476Sjbforeach $dtrace_cmd (@dtrace_cmds) { 685178476Sjb run_tests($dtrace_cmd, $exception_lists{$dtrace_cmd}); 686178476Sjb} 687178476Sjb 688178476Sjb$opt_q = 0; # force final summary to appear regardless of -q option 689178476Sjb 690178476Sjblogmsg("\n==== TEST RESULTS ====\n"); 691178476Sjbforeach $key (keys %results) { 692178476Sjb my $passed = $results{$key}{"passed"}; 693178476Sjb my $bypassed = $results{$key}{"bypassed"}; 694178476Sjb my $failed = $results{$key}{"failed"}; 695178476Sjb my $total = $results{$key}{"total"}; 696178476Sjb 697178476Sjb logmsg("\n mode: " . $key . "\n"); 698178476Sjb logmsg(" passed: " . $passed . "\n"); 699178476Sjb if ($bypassed) { 700178476Sjb logmsg(" bypassed: " . $bypassed . "\n"); 701178476Sjb } 702178476Sjb logmsg(" failed: " . $failed . "\n"); 703178476Sjb logmsg(" total: " . $total . "\n"); 704178476Sjb} 705178476Sjb 706178476Sjbexit($errs != 0); 707