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