xref: /titanic_50/usr/src/cmd/dtrace/test/cmd/scripts/dtest.pl (revision e5803b76927480e8f9b67b22201c484ccf4c2bcf)
1#!/usr/perl5/bin/perl
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27
28#
29# Copyright (c) 2011, Joyent, Inc. All rights reserved.
30# Copyright (c) 2012 by Delphix. All rights reserved.
31#
32require 5.8.4;
33
34use File::Find;
35use File::Basename;
36use Getopt::Std;
37use Cwd;
38use Cwd 'abs_path';
39
40$PNAME = $0;
41$PNAME =~ s:.*/::;
42$OPTSTR = 'abd:fFghi:jlnqsx:';
43$USAGE = "Usage: $PNAME [-abfFghjlnqs] [-d dir] [-i isa] "
44    . "[-x opt[=arg]] [file | dir ...]\n";
45($MACH = `uname -p`) =~ s/\W*\n//;
46($PLATFORM = `uname -i`) =~ s/\W*\n//;
47
48@dtrace_argv = ();
49
50$ksh_path = '/usr/bin/ksh';
51
52@files = ();
53%exceptions = ();
54%results = ();
55$errs = 0;
56
57#
58# If no test files are specified on the command-line, execute a find on "."
59# and append any tst.*.d, tst.*.ksh, err.*.d or drp.*.d files found within
60# the directory tree.
61#
62sub wanted
63{
64	push(@files, $File::Find::name)
65	    if ($_ =~ /^(tst|err|drp)\..+\.(d|ksh)$/ && -f "$_");
66}
67
68sub dirname {
69	my($s) = @_;
70	my($i);
71
72	$s = substr($s, 0, $i) if (($i = rindex($s, '/')) != -1);
73	return $i == -1 ? '.' : $i == 0 ? '/' : $s;
74}
75
76sub inpath
77{
78	my ($exec) = (@_);
79	my @path = File::Spec->path();
80
81	for my $dir (@path) {
82		if (-x $dir . "/" . $exec) {
83			return 1;
84		}
85	}
86
87	return 0;
88}
89
90sub usage
91{
92	print $USAGE;
93	print "\t -a  execute test suite using anonymous enablings\n";
94	print "\t -b  execute bad ioctl test program\n";
95	print "\t -d  specify directory for test results files and cores\n";
96	print "\t -g  enable libumem debugging when running tests\n";
97	print "\t -f  force bypassed tests to run\n";
98	print "\t -F  force tests to be run, even if missing dependencies\n";
99	print "\t -h  display verbose usage message\n";
100	print "\t -i  specify ISA to test instead of isaexec(3C) default\n";
101	print "\t -j  execute test suite using jdtrace (Java API) only\n";
102	print "\t -l  save log file of results and PIDs used by tests\n";
103	print "\t -n  execute test suite using dtrace(1m) only\n";
104	print "\t -q  set quiet mode (only report errors and summary)\n";
105	print "\t -s  save results files even for tests that pass\n";
106	print "\t -x  pass corresponding -x argument to dtrace(1M)\n";
107	exit(2);
108}
109
110sub errmsg
111{
112	my($msg) = @_;
113
114	print STDERR $msg;
115	print LOG $msg if ($opt_l);
116	$errs++;
117}
118
119sub fail
120{
121	my(@parms) = @_;
122	my($msg) = $parms[0];
123	my($errfile) = $parms[1];
124	my($n) = 0;
125	my($dest) = basename($file);
126
127	while (-d "$opt_d/failure.$n") {
128		$n++;
129	}
130
131	unless (mkdir "$opt_d/failure.$n") {
132		warn "ERROR: failed to make directory $opt_d/failure.$n: $!\n";
133		exit(125);
134	}
135
136	open(README, ">$opt_d/failure.$n/README");
137	print README "ERROR: " . $file . " " . $msg;
138
139	if (scalar @parms > 1) {
140		print README "; see $errfile\n";
141	} else {
142		if (-f "$opt_d/$pid.core") {
143			print README "; see $pid.core\n";
144		} else {
145			print README "\n";
146		}
147	}
148
149	close(README);
150
151	if (-f "$opt_d/$pid.out") {
152		rename("$opt_d/$pid.out", "$opt_d/failure.$n/$pid.out");
153		link("$file.out", "$opt_d/failure.$n/$dest.out");
154	}
155
156	if (-f "$opt_d/$pid.err") {
157		rename("$opt_d/$pid.err", "$opt_d/failure.$n/$pid.err");
158		link("$file.err", "$opt_d/failure.$n/$dest.err");
159	}
160
161	if (-f "$opt_d/$pid.core") {
162		rename("$opt_d/$pid.core", "$opt_d/failure.$n/$pid.core");
163	}
164
165	link("$file", "$opt_d/failure.$n/$dest");
166
167	$msg = "ERROR: " . $dest . " " . $msg;
168
169	if (scalar @parms > 1) {
170		$msg = $msg . "; see $errfile in failure.$n\n";
171	} else {
172		$msg = $msg . "; details in failure.$n\n";
173	}
174
175	errmsg($msg);
176}
177
178sub logmsg
179{
180	my($msg) = @_;
181
182	print STDOUT $msg unless ($opt_q);
183	print LOG $msg if ($opt_l);
184}
185
186# Trim leading and trailing whitespace
187sub trim {
188	my($s) = @_;
189
190	$s =~ s/^\s*//;
191	$s =~ s/\s*$//;
192	return $s;
193}
194
195# Load exception set of skipped tests from the file at the given
196# pathname. The test names are assumed to be paths relative to $dt_tst,
197# for example: common/aggs/tst.neglquant.d, and specify tests to be
198# skipped.
199sub load_exceptions {
200	my($listfile) = @_;
201	my($line) = "";
202
203	%exceptions = ();
204	if (length($listfile) > 0) {
205		exit(123) unless open(STDIN, "<$listfile");
206		while (<STDIN>) {
207			chomp;
208			$line = $_;
209			# line is non-empty and not a comment
210			if ((length($line) > 0) && ($line =~ /^\s*[^\s#]/ )) {
211				$exceptions{trim($line)} = 1;
212			}
213		}
214	}
215}
216
217# Return 1 if the test is found in the exception set, 0 otherwise.
218sub is_exception {
219	my($file) = @_;
220	my($i) = -1;
221
222	if (scalar(keys(%exceptions)) == 0) {
223		return 0;
224	}
225
226	# hash absolute pathname after $dt_tst/
227	$file = abs_path($file);
228	$i = index($file, $dt_tst);
229	if ($i == 0) {
230		$file = substr($file, length($dt_tst) + 1);
231		return $exceptions{$file};
232	}
233	return 0;
234}
235
236#
237# Iterate over the set of test files specified on the command-line or by a find
238# on "$defdir/common", "$defdir/$MACH" and "$defdir/$PLATFORM" and execute each
239# one.  If the test file is executable, we fork and exec it. If the test is a
240# .ksh file, we run it with $ksh_path. Otherwise we run dtrace -s on it.  If
241# the file is named tst.* we assume it should return exit status 0.  If the
242# file is named err.* we assume it should return exit status 1.  If the file is
243# named err.D_[A-Z0-9]+[.*].d we use dtrace -xerrtags and examine stderr to
244# ensure that a matching error tag was produced.  If the file is named
245# drp.[A-Z0-9]+[.*].d we use dtrace -xdroptags and examine stderr to ensure
246# that a matching drop tag was produced.  If any *.out or *.err files are found
247# we perform output comparisons.
248#
249# run_tests takes two arguments: The first is the pathname of the dtrace
250# command to invoke when running the tests. The second is the pathname
251# of a file (may be the empty string) listing tests that ought to be
252# skipped (skipped tests are listed as paths relative to $dt_tst, for
253# example: common/aggs/tst.neglquant.d).
254#
255sub run_tests {
256	my($dtrace, $exceptions_path) = @_;
257	my($passed) = 0;
258	my($bypassed) = 0;
259	my($failed) = $errs;
260	my($total) = 0;
261
262	die "$PNAME: $dtrace not found; aborting\n" unless (-x "$dtrace");
263	logmsg("executing tests using $dtrace ...\n");
264
265	load_exceptions($exceptions_path);
266
267	foreach $file (sort @files) {
268		$file =~ m:.*/((.*)\.(\w+)):;
269		$name = $1;
270		$base = $2;
271		$ext = $3;
272
273		$dir = dirname($file);
274		$isksh = 0;
275		$tag = 0;
276		$droptag = 0;
277
278		if ($name =~ /^tst\./) {
279			$isksh = ($ext eq 'ksh');
280			$status = 0;
281		} elsif ($name =~ /^err\.(D_[A-Z0-9_]+)\./) {
282			$status = 1;
283			$tag = $1;
284		} elsif ($name =~ /^err\./) {
285			$status = 1;
286		} elsif ($name =~ /^drp\.([A-Z0-9_]+)\./) {
287			$status = 0;
288			$droptag = $1;
289		} else {
290			errmsg("ERROR: $file is not a valid test file name\n");
291			next;
292		}
293
294		$fullname = "$dir/$name";
295		$exe = "$dir/$base.exe";
296		$exe_pid = -1;
297
298		if ($opt_a && ($status != 0 || $tag != 0 || $droptag != 0 ||
299		    -x $exe || $isksh || -x $fullname)) {
300			$bypassed++;
301			next;
302		}
303
304		if (!$opt_f && is_exception("$dir/$name")) {
305			$bypassed++;
306			next;
307		}
308
309		if (!$isksh && -x $exe) {
310			if (($exe_pid = fork()) == -1) {
311				errmsg(
312				    "ERROR: failed to fork to run $exe: $!\n");
313				next;
314			}
315
316			if ($exe_pid == 0) {
317				open(STDIN, '</dev/null');
318
319				exec($exe);
320
321				warn "ERROR: failed to exec $exe: $!\n";
322			}
323		}
324
325		logmsg("testing $file ... ");
326
327		if (($pid = fork()) == -1) {
328			errmsg("ERROR: failed to fork to run test $file: $!\n");
329			next;
330		}
331
332		if ($pid == 0) {
333			open(STDIN, '</dev/null');
334			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
335			exit(125) unless open(STDERR, ">$opt_d/$$.err");
336
337			unless (chdir($dir)) {
338				warn "ERROR: failed to chdir for $file: $!\n";
339				exit(126);
340			}
341
342			push(@dtrace_argv, '-xerrtags') if ($tag);
343			push(@dtrace_argv, '-xdroptags') if ($droptag);
344			push(@dtrace_argv, $exe_pid) if ($exe_pid != -1);
345
346			if ($isksh) {
347				exit(123) unless open(STDIN, "<$name");
348				exec("$ksh_path /dev/stdin $dtrace");
349			} elsif (-x $name) {
350				warn "ERROR: $name is executable\n";
351				exit(1);
352			} else {
353				if ($tag == 0 && $status == $0 && $opt_a) {
354					push(@dtrace_argv, '-A');
355				}
356
357				push(@dtrace_argv, '-C');
358				push(@dtrace_argv, '-s');
359				push(@dtrace_argv, $name);
360				exec($dtrace, @dtrace_argv);
361			}
362
363			warn "ERROR: failed to exec for $file: $!\n";
364			exit(127);
365		}
366
367		if (waitpid($pid, 0) == -1) {
368			errmsg("ERROR: timed out waiting for $file\n");
369			kill(9, $exe_pid) if ($exe_pid != -1);
370			kill(9, $pid);
371			next;
372		}
373
374		kill(9, $exe_pid) if ($exe_pid != -1);
375
376		if ($tag == 0 && $status == $0 && $opt_a) {
377			#
378			# We can chuck the earler output.
379			#
380			unlink($pid . '.out');
381			unlink($pid . '.err');
382
383			#
384			# This is an anonymous enabling.  We need to get
385			# the module unloaded.
386			#
387			system("dtrace -ae 1> /dev/null 2> /dev/null");
388			system("svcadm disable -s " .
389			    "svc:/network/nfs/mapid:default");
390			system("modunload -i 0 ; modunload -i 0 ; " .
391			    "modunload -i 0");
392			if (!system("modinfo | grep dtrace")) {
393				warn "ERROR: couldn't unload dtrace\n";
394				system("svcadm enable " .
395				    "-s svc:/network/nfs/mapid:default");
396				exit(124);
397			}
398
399			#
400			# DTrace is gone.  Now update_drv(1M), and rip
401			# everything out again.
402			#
403			system("update_drv dtrace");
404			system("dtrace -ae 1> /dev/null 2> /dev/null");
405			system("modunload -i 0 ; modunload -i 0 ; " .
406			    "modunload -i 0");
407			if (!system("modinfo | grep dtrace")) {
408				warn "ERROR: couldn't unload dtrace\n";
409				system("svcadm enable " .
410				    "-s svc:/network/nfs/mapid:default");
411				exit(124);
412			}
413
414			#
415			# Now bring DTrace back in.
416			#
417			system("sync ; sync");
418			system("dtrace -l -n bogusprobe 1> /dev/null " .
419			    "2> /dev/null");
420			system("svcadm enable -s " .
421			    "svc:/network/nfs/mapid:default");
422
423			#
424			# That should have caused DTrace to reload with
425			# the new configuration file.  Now we can try to
426			# snag our anonymous state.
427			#
428			if (($pid = fork()) == -1) {
429				errmsg("ERROR: failed to fork to run " .
430				    "test $file: $!\n");
431				next;
432			}
433
434			if ($pid == 0) {
435				open(STDIN, '</dev/null');
436				exit(125) unless open(STDOUT, ">$opt_d/$$.out");
437				exit(125) unless open(STDERR, ">$opt_d/$$.err");
438
439				push(@dtrace_argv, '-a');
440
441				unless (chdir($dir)) {
442					warn "ERROR: failed to chdir " .
443					    "for $file: $!\n";
444					exit(126);
445				}
446
447				exec($dtrace, @dtrace_argv);
448				warn "ERROR: failed to exec for $file: $!\n";
449				exit(127);
450			}
451
452			if (waitpid($pid, 0) == -1) {
453				errmsg("ERROR: timed out waiting for $file\n");
454				kill(9, $pid);
455				next;
456			}
457		}
458
459		logmsg("[$pid]\n");
460		$wstat = $?;
461		$wifexited = ($wstat & 0xFF) == 0;
462		$wexitstat = ($wstat >> 8) & 0xFF;
463		$wtermsig = ($wstat & 0x7F);
464
465		if (!$wifexited) {
466			fail("died from signal $wtermsig");
467			next;
468		}
469
470		if ($wexitstat == 125) {
471			die "$PNAME: failed to create output file in $opt_d " .
472			    "(cd elsewhere or use -d)\n";
473		}
474
475		if ($wexitstat != $status) {
476			fail("returned $wexitstat instead of $status");
477			next;
478		}
479
480		if (-f "$file.out" &&
481		    system("cmp -s $file.out $opt_d/$pid.out") != 0) {
482			fail("stdout mismatch", "$pid.out");
483			next;
484		}
485
486		if (-f "$file.err" &&
487		    system("cmp -s $file.err $opt_d/$pid.err") != 0) {
488			fail("stderr mismatch: see $pid.err");
489			next;
490		}
491
492		if ($tag) {
493			open(TSTERR, "<$opt_d/$pid.err");
494			$tsterr = <TSTERR>;
495			close(TSTERR);
496
497			unless ($tsterr =~ /: \[$tag\] line \d+:/) {
498				fail("errtag mismatch: see $pid.err");
499				next;
500			}
501		}
502
503		if ($droptag) {
504			$found = 0;
505			open(TSTERR, "<$opt_d/$pid.err");
506
507			while (<TSTERR>) {
508				if (/\[$droptag\] /) {
509					$found = 1;
510					last;
511				}
512			}
513
514			close (TSTERR);
515
516			unless ($found) {
517				fail("droptag mismatch: see $pid.err");
518				next;
519			}
520		}
521
522		unless ($opt_s) {
523			unlink($pid . '.out');
524			unlink($pid . '.err');
525		}
526	}
527
528	if ($opt_a) {
529		#
530		# If we're running with anonymous enablings, we need to
531		# restore the .conf file.
532		#
533		system("dtrace -A 1> /dev/null 2> /dev/null");
534		system("dtrace -ae 1> /dev/null 2> /dev/null");
535		system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
536		system("update_drv dtrace");
537	}
538
539	$total = scalar(@files);
540	$failed = $errs - $failed;
541	$passed = ($total - $failed - $bypassed);
542	$results{$dtrace} = {
543		"passed" => $passed,
544		"bypassed" => $bypassed,
545		"failed" => $failed,
546		"total" => $total
547	};
548}
549
550die $USAGE unless (getopts($OPTSTR));
551usage() if ($opt_h);
552
553foreach $arg (@ARGV) {
554	if (-f $arg) {
555		push(@files, $arg);
556	} elsif (-d $arg) {
557		find(\&wanted, $arg);
558	} else {
559		die "$PNAME: $arg is not a valid file or directory\n";
560	}
561}
562
563$dt_tst = '/opt/SUNWdtrt/tst';
564$dt_bin = '/opt/SUNWdtrt/bin';
565$defdir = -d $dt_tst ? $dt_tst : '.';
566$bindir = -d $dt_bin ? $dt_bin : '.';
567
568if (!$opt_F) {
569	my @dependencies = ("gcc", "make", "java", "perl");
570
571	for my $dep (@dependencies) {
572		if (!inpath($dep)) {
573			die "$PNAME: '$dep' not found (use -F to force run)\n";
574		}
575	}
576}
577
578find(\&wanted, "$defdir/common") if (scalar(@ARGV) == 0);
579find(\&wanted, "$defdir/$MACH") if (scalar(@ARGV) == 0);
580find(\&wanted, "$defdir/$PLATFORM") if (scalar(@ARGV) == 0);
581
582die $USAGE if (scalar(@files) == 0);
583
584$dtrace_path = '/usr/sbin/dtrace';
585$jdtrace_path = "$bindir/jdtrace";
586
587%exception_lists = ("$jdtrace_path" => "$bindir/exception.lst");
588
589if ($opt_j || $opt_n || $opt_i) {
590	@dtrace_cmds = ();
591	push(@dtrace_cmds, $dtrace_path) if ($opt_n);
592	push(@dtrace_cmds, $jdtrace_path) if ($opt_j);
593	push(@dtrace_cmds, "/usr/sbin/$opt_i/dtrace") if ($opt_i);
594} else {
595	@dtrace_cmds = ($dtrace_path);
596}
597
598if ($opt_d) {
599	die "$PNAME: -d arg must be absolute path\n" unless ($opt_d =~ /^\//);
600	die "$PNAME: -d arg $opt_d is not a directory\n" unless (-d "$opt_d");
601	system("coreadm -p $opt_d/%p.core");
602} else {
603	my $dir = getcwd;
604	system("coreadm -p $dir/%p.core");
605	$opt_d = '.';
606}
607
608if ($opt_x) {
609	push(@dtrace_argv, '-x');
610	push(@dtrace_argv, $opt_x);
611}
612
613die "$PNAME: failed to open $PNAME.$$.log: $!\n"
614    unless (!$opt_l || open(LOG, ">$PNAME.$$.log"));
615
616$ENV{'DTRACE_DEBUG_REGSET'} = 'true';
617
618if ($opt_g) {
619	$ENV{'UMEM_DEBUG'} = 'default,verbose';
620	$ENV{'UMEM_LOGGING'} = 'fail,contents';
621	$ENV{'LD_PRELOAD'} = 'libumem.so';
622}
623
624if ($opt_b) {
625	logmsg("badioctl'ing ... ");
626
627	if (($badioctl = fork()) == -1) {
628		errmsg("ERROR: failed to fork to run badioctl: $!\n");
629		next;
630	}
631
632	if ($badioctl == 0) {
633		open(STDIN, '</dev/null');
634		exit(125) unless open(STDOUT, ">$opt_d/$$.out");
635		exit(125) unless open(STDERR, ">$opt_d/$$.err");
636
637		exec($bindir . "/badioctl");
638		warn "ERROR: failed to exec badioctl: $!\n";
639		exit(127);
640	}
641
642
643	logmsg("[$badioctl]\n");
644
645	#
646	# If we're going to be bad, we're just going to iterate over each
647	# test file.
648	#
649	foreach $file (sort @files) {
650		($name = $file) =~ s:.*/::;
651		$dir = dirname($file);
652
653		if (!($name =~ /^tst\./ && $name =~ /\.d$/)) {
654			next;
655		}
656
657		logmsg("baddof'ing $file ... ");
658
659		if (($pid = fork()) == -1) {
660			errmsg("ERROR: failed to fork to run baddof: $!\n");
661			next;
662		}
663
664		if ($pid == 0) {
665			open(STDIN, '</dev/null');
666			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
667			exit(125) unless open(STDERR, ">$opt_d/$$.err");
668
669			unless (chdir($dir)) {
670				warn "ERROR: failed to chdir for $file: $!\n";
671				exit(126);
672			}
673
674			exec($bindir . "/baddof", $name);
675
676			warn "ERROR: failed to exec for $file: $!\n";
677			exit(127);
678		}
679
680		sleep 60;
681		kill(9, $pid);
682		waitpid($pid, 0);
683
684		logmsg("[$pid]\n");
685
686		unless ($opt_s) {
687			unlink($pid . '.out');
688			unlink($pid . '.err');
689		}
690	}
691
692	kill(9, $badioctl);
693	waitpid($badioctl, 0);
694
695	unless ($opt_s) {
696		unlink($badioctl . '.out');
697		unlink($badioctl . '.err');
698	}
699
700	exit(0);
701}
702
703#
704# Run all the tests specified on the command-line (the entire test suite
705# by default) once for each dtrace command tested, skipping any tests
706# not valid for that command.
707#
708foreach $dtrace_cmd (@dtrace_cmds) {
709	run_tests($dtrace_cmd, $exception_lists{$dtrace_cmd});
710}
711
712$opt_q = 0; # force final summary to appear regardless of -q option
713
714logmsg("\n==== TEST RESULTS ====\n");
715foreach $key (keys %results) {
716	my $passed = $results{$key}{"passed"};
717	my $bypassed = $results{$key}{"bypassed"};
718	my $failed = $results{$key}{"failed"};
719	my $total = $results{$key}{"total"};
720
721	logmsg("\n     mode: " . $key . "\n");
722	logmsg("   passed: " . $passed . "\n");
723	if ($bypassed) {
724		logmsg(" bypassed: " . $bypassed . "\n");
725	}
726	logmsg("   failed: " . $failed . "\n");
727	logmsg("    total: " . $total . "\n");
728}
729
730exit($errs != 0);
731