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