source: branches/samba-3.5.x/selftest/selftest.pl

Last change on this file was 414, checked in by Herwig Bauernfeind, 15 years ago

Samba 3.5.0: Initial import
File size: 19.3 KB
Line 
1#!/usr/bin/perl
2# Bootstrap Samba and run a number of tests against it.
3# Copyright (C) 2005-2009 Jelmer Vernooij <jelmer@samba.org>
4# Copyright (C) 2007-2009 Stefan Metzmacher <metze@samba.org>
5
6# This program is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 3 of the License, or
9# (at your option) any later version.
10
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15
16# You should have received a copy of the GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19=pod
20
21=head1 NAME
22
23selftest - Samba test runner
24
25=head1 SYNOPSIS
26
27selftest --help
28
29selftest [--srcdir=DIR] [--builddir=DIR] [--exeext=EXT][--target=samba4|samba3|win|kvm] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--testlist=FILE] [TESTS]
30
31=head1 DESCRIPTION
32
33A simple test runner. TESTS is a regular expression with tests to run.
34
35=head1 OPTIONS
36
37=over 4
38
39=item I<--help>
40
41Show list of available options.
42
43=item I<--srcdir=DIR>
44
45Source directory.
46
47=item I<--builddir=DIR>
48
49Build directory.
50
51=item I<--exeext=EXT>
52
53Executable extention
54
55=item I<--prefix=DIR>
56
57Change directory to run tests in. Default is 'st'.
58
59=item I<--target samba4|samba3|win|kvm>
60
61Specify test target against which to run. Default is 'samba4'.
62
63=item I<--quick>
64
65Run only a limited number of tests. Intended to run in about 30 seconds on
66moderately recent systems.
67
68=item I<--socket-wrapper>
69
70Use socket wrapper library for communication with server. Only works
71when the server is running locally.
72
73Will prevent TCP and UDP ports being opened on the local host but
74(transparently) redirects these calls to use unix domain sockets.
75
76=item I<--exclude>
77
78Specify a file containing a list of tests that should be skipped. Possible
79candidates are tests that segfault the server, flip or don't end.
80
81=item I<--include>
82
83Specify a file containing a list of tests that should be run. Same format
84as the --exclude flag.
85
86Not includes specified means all tests will be run.
87
88=item I<--one>
89
90Abort as soon as one test fails.
91
92=item I<--testlist>
93
94Load a list of tests from the specified location.
95
96=back
97
98=head1 ENVIRONMENT
99
100=over 4
101
102=item I<SMBD_VALGRIND>
103
104=item I<TORTURE_MAXTIME>
105
106=item I<VALGRIND>
107
108=item I<TLS_ENABLED>
109
110=item I<srcdir>
111
112=back
113
114=head1 LICENSE
115
116selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
117
118=head1 AUTHOR
119
120Jelmer Vernooij
121
122=cut
123
124use strict;
125
126use FindBin qw($RealBin $Script);
127use File::Spec;
128use Getopt::Long;
129use POSIX;
130use Cwd qw(abs_path);
131use lib "$RealBin";
132use Subunit qw(parse_results);
133use Subunit::Filter;
134use SocketWrapper;
135
136my $opt_help = 0;
137my $opt_target = "samba4";
138my $opt_quick = 0;
139my $opt_socket_wrapper = 0;
140my $opt_socket_wrapper_pcap = undef;
141my $opt_socket_wrapper_keep_pcap = undef;
142my $opt_one = 0;
143my @opt_exclude = ();
144my @opt_include = ();
145my $opt_verbose = 0;
146my $opt_image = undef;
147my $opt_testenv = 0;
148my $ldap = undef;
149my $opt_analyse_cmd = undef;
150my $opt_resetup_env = undef;
151my $opt_bindir = undef;
152my $opt_no_lazy_setup = undef;
153my @testlists = ();
154
155my $srcdir = ".";
156my $builddir = ".";
157my $exeext = "";
158my $prefix = "./st";
159
160my @includes = ();
161my @excludes = ();
162
163sub find_in_list($$)
164{
165 my ($list, $fullname) = @_;
166
167 foreach (@$list) {
168 if ($fullname =~ /$$_[0]/) {
169 return ($$_[1]) if ($$_[1]);
170 return "";
171 }
172 }
173
174 return undef;
175}
176
177sub skip($)
178{
179 my ($name) = @_;
180
181 return find_in_list(\@excludes, $name);
182}
183
184sub getlog_env($);
185
186sub setup_pcap($)
187{
188 my ($name) = @_;
189
190 return unless ($opt_socket_wrapper_pcap);
191 return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
192
193 my $fname = $name;
194 $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
195
196 my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
197
198 SocketWrapper::setup_pcap($pcap_file);
199
200 return $pcap_file;
201}
202
203sub cleanup_pcap($$)
204{
205 my ($pcap_file, $exitcode) = @_;
206
207 return unless ($opt_socket_wrapper_pcap);
208 return if ($opt_socket_wrapper_keep_pcap);
209 return unless ($exitcode == 0);
210 return unless defined($pcap_file);
211
212 unlink($pcap_file);
213}
214
215sub run_testsuite($$$$$)
216{
217 my ($envname, $name, $cmd, $i, $totalsuites) = @_;
218 my $pcap_file = setup_pcap($name);
219
220 Subunit::start_testsuite($name);
221 Subunit::report_time(time());
222
223 open(RESULTS, "$cmd 2>&1|");
224 my $statistics = {
225 TESTS_UNEXPECTED_OK => 0,
226 TESTS_EXPECTED_OK => 0,
227 TESTS_UNEXPECTED_FAIL => 0,
228 TESTS_EXPECTED_FAIL => 0,
229 TESTS_ERROR => 0,
230 TESTS_SKIP => 0,
231 };
232
233 my $msg_ops = new Subunit::Filter("$name\.", []);
234
235 parse_results($msg_ops, $statistics, *RESULTS);
236
237 my $ret = 0;
238
239 unless (close(RESULTS)) {
240 if ($!) {
241 Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
242 return 0;
243 } else {
244 $ret = $?;
245 }
246 }
247
248 if ($ret & 127) {
249 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
250 return 0;
251 }
252 my $envlog = getlog_env($envname);
253 if ($envlog ne "") {
254 print "envlog: $envlog\n";
255 }
256
257 print "command: $cmd\n";
258
259 my $exitcode = $ret >> 8;
260
261 Subunit::report_time(time());
262 if ($exitcode == 0) {
263 Subunit::end_testsuite($name, "success");
264 } else {
265 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
266 }
267
268 cleanup_pcap($pcap_file, $exitcode);
269
270 if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
271 print "PCAP FILE: $pcap_file\n";
272 }
273
274 if ($exitcode != 0) {
275 exit(1) if ($opt_one);
276 }
277
278 return $exitcode;
279}
280
281sub ShowHelp()
282{
283 print "Samba test runner
284Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
285Copyright (C) Stefan Metzmacher <metze\@samba.org>
286
287Usage: $Script [OPTIONS] TESTNAME-REGEX
288
289Generic options:
290 --help this help page
291 --target=samba[34]|win|kvm Samba version to target
292 --testlist=FILE file to read available tests from
293
294Paths:
295 --prefix=DIR prefix to run tests in [st]
296 --srcdir=DIR source directory [.]
297 --builddir=DIR output directory [.]
298 --exeext=EXT executable extention []
299
300Target Specific:
301 --socket-wrapper-pcap save traffic to pcap directories
302 --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
303 failed
304 --socket-wrapper enable socket wrapper
305 --bindir=PATH path to target binaries
306
307Samba4 Specific:
308 --ldap=openldap|fedora-ds back samba onto specified ldap server
309
310Kvm Specific:
311 --image=PATH path to KVM image
312
313Behaviour:
314 --quick run quick overall test
315 --one abort when the first test fails
316 --verbose be verbose
317 --analyse-cmd CMD command to run after each test
318";
319 exit(0);
320}
321
322my $result = GetOptions (
323 'help|h|?' => \$opt_help,
324 'target=s' => \$opt_target,
325 'prefix=s' => \$prefix,
326 'socket-wrapper' => \$opt_socket_wrapper,
327 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
328 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
329 'quick' => \$opt_quick,
330 'one' => \$opt_one,
331 'exclude=s' => \@opt_exclude,
332 'include=s' => \@opt_include,
333 'srcdir=s' => \$srcdir,
334 'builddir=s' => \$builddir,
335 'exeext=s' => \$exeext,
336 'verbose' => \$opt_verbose,
337 'testenv' => \$opt_testenv,
338 'ldap:s' => \$ldap,
339 'analyse-cmd=s' => \$opt_analyse_cmd,
340 'no-lazy-setup' => \$opt_no_lazy_setup,
341 'resetup-environment' => \$opt_resetup_env,
342 'bindir:s' => \$opt_bindir,
343 'image=s' => \$opt_image,
344 'testlist=s' => \@testlists
345 );
346
347exit(1) if (not $result);
348
349ShowHelp() if ($opt_help);
350
351my @tests = @ARGV;
352
353# quick hack to disable rpc validation when using valgrind - its way too slow
354unless (defined($ENV{VALGRIND})) {
355 $ENV{VALIDATE} = "validate";
356 $ENV{MALLOC_CHECK_} = 2;
357}
358
359my $bindir = ($opt_bindir or "$builddir/bin");
360my $bindir_abs = abs_path($bindir);
361
362# Backwards compatibility:
363if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
364 if (defined($ENV{FEDORA_DS_ROOT})) {
365 $ldap = "fedora-ds";
366 } else {
367 $ldap = "openldap";
368 }
369}
370
371my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
372if ($ldap) {
373 # LDAP is slow
374 $torture_maxtime *= 2;
375}
376
377$prefix =~ s+//+/+;
378$prefix =~ s+/./+/+;
379$prefix =~ s+/$++;
380
381die("using an empty prefix isn't allowed") unless $prefix ne "";
382
383#Ensure we have the test prefix around
384mkdir($prefix, 0777) unless -d $prefix;
385
386my $prefix_abs = abs_path($prefix);
387my $srcdir_abs = abs_path($srcdir);
388my $builddir_abs = abs_path($builddir);
389
390die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
391die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
392
393$ENV{PREFIX} = $prefix;
394$ENV{KRB5CCNAME} = "$prefix/krb5ticket";
395$ENV{PREFIX_ABS} = $prefix_abs;
396$ENV{SRCDIR} = $srcdir;
397$ENV{SRCDIR_ABS} = $srcdir_abs;
398$ENV{BUILDDIR} = $builddir;
399$ENV{BUILDDIR_ABS} = $builddir_abs;
400$ENV{EXEEXT} = $exeext;
401
402my $tls_enabled = not $opt_quick;
403$ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
404$ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
405$ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
406sub prefix_pathvar($$)
407{
408 my ($name, $newpath) = @_;
409 if (defined($ENV{$name})) {
410 $ENV{$name} = "$newpath:$ENV{$name}";
411 } else {
412 $ENV{$name} = $newpath;
413 }
414}
415prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
416prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
417
418if ($opt_socket_wrapper_keep_pcap) {
419 # Socket wrapper keep pcap implies socket wrapper pcap
420 $opt_socket_wrapper_pcap = 1;
421}
422
423if ($opt_socket_wrapper_pcap) {
424 # Socket wrapper pcap implies socket wrapper
425 $opt_socket_wrapper = 1;
426}
427
428my $socket_wrapper_dir;
429if ($opt_socket_wrapper) {
430 $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
431 print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
432} else {
433 unless ($< == 0) {
434 print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
435 }
436}
437
438my $target;
439my $testenv_default = "none";
440
441if ($opt_target eq "samba4") {
442 $testenv_default = "member";
443 require target::Samba4;
444 $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
445} elsif ($opt_target eq "samba3") {
446 if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
447 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'. Exiting....");
448 }
449 $testenv_default = "member";
450 require target::Samba3;
451 $target = new Samba3($bindir);
452} elsif ($opt_target eq "win") {
453 die("Windows tests will not run with socket wrapper enabled.")
454 if ($opt_socket_wrapper);
455 $testenv_default = "dc";
456 require target::Windows;
457 $target = new Windows();
458} elsif ($opt_target eq "kvm") {
459 die("Kvm tests will not run with socket wrapper enabled.")
460 if ($opt_socket_wrapper);
461 require target::Kvm;
462 die("No image specified") unless ($opt_image);
463 $target = new Kvm($opt_image, undef);
464}
465
466#
467# Start a Virtual Distributed Ethernet Switch
468# Returns the pid of the switch.
469#
470sub start_vde_switch($)
471{
472 my ($path) = @_;
473
474 system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
475
476 open(PID, "$path/vde.pid");
477 <PID> =~ /([0-9]+)/;
478 my $pid = $1;
479 close(PID);
480
481 return $pid;
482}
483
484# Stop a Virtual Distributed Ethernet Switch
485sub stop_vde_switch($)
486{
487 my ($pid) = @_;
488 kill 9, $pid;
489}
490
491sub read_test_regexes($)
492{
493 my ($name) = @_;
494 my @ret = ();
495 open(LF, "<$name") or die("unable to read $name: $!");
496 while (<LF>) {
497 chomp;
498 next if (/^#/);
499 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
500 push (@ret, [$1, $4]);
501 } else {
502 s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
503 push (@ret, [$_, undef]);
504 }
505 }
506 close(LF);
507 return @ret;
508}
509
510foreach (@opt_exclude) {
511 push (@excludes, read_test_regexes($_));
512}
513
514foreach (@opt_include) {
515 push (@includes, read_test_regexes($_));
516}
517
518my $interfaces = join(',', ("127.0.0.6/8",
519 "127.0.0.7/8",
520 "127.0.0.8/8",
521 "127.0.0.9/8",
522 "127.0.0.10/8",
523 "127.0.0.11/8"));
524
525my $conffile = "$prefix_abs/client/client.conf";
526$ENV{SMB_CONF_PATH} = $conffile;
527
528sub write_clientconf($$)
529{
530 my ($conffile, $vars) = @_;
531
532 mkdir("$prefix/client", 0777) unless -d "$prefix/client";
533
534 if ( -d "$prefix/client/private" ) {
535 unlink <$prefix/client/private/*>;
536 } else {
537 mkdir("$prefix/client/private", 0777);
538 }
539
540 if ( -d "$prefix/client/lockdir" ) {
541 unlink <$prefix/client/lockdir/*>;
542 } else {
543 mkdir("$prefix/client/lockdir", 0777);
544 }
545
546 if ( -d "$prefix_abs/client/ncalrpcdir" ) {
547 unlink <$prefix/client/ncalrpcdir/*>;
548 } else {
549 mkdir("$prefix/client/ncalrpcdir", 0777);
550 }
551
552 open(CF, ">$conffile");
553 print CF "[global]\n";
554 if (defined($ENV{VALGRIND})) {
555 print CF "\ticonv:native = true\n";
556 } else {
557 print CF "\ticonv:native = false\n";
558 }
559 print CF "\tnetbios name = client\n";
560 if (defined($vars->{DOMAIN})) {
561 print CF "\tworkgroup = $vars->{DOMAIN}\n";
562 }
563 if (defined($vars->{REALM})) {
564 print CF "\trealm = $vars->{REALM}\n";
565 }
566 if ($opt_socket_wrapper) {
567 print CF "\tinterfaces = $interfaces\n";
568 }
569 print CF "
570 private dir = $prefix_abs/client/private
571 lock dir = $prefix_abs/client/lockdir
572 ncalrpc dir = $prefix_abs/client/ncalrpcdir
573 name resolve order = bcast
574 panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
575 max xmit = 32K
576 notify:inotify = false
577 ldb:nosync = true
578 system:anonymous = true
579 client lanman auth = Yes
580 torture:basedir = $prefix_abs/client
581#We don't want to pass our self-tests if the PAC code is wrong
582 gensec:require_pac = true
583 modules dir = $ENV{LD_SAMBA_MODULE_PATH}
584";
585 close(CF);
586}
587
588my @todo = ();
589
590my $testsdir = "$srcdir/selftest";
591
592my %required_envs = ();
593
594sub should_run_test($)
595{
596 my $name = shift;
597 if ($#tests == -1) {
598 return 1;
599 }
600 for (my $i=0; $i <= $#tests; $i++) {
601 if ($name =~ /$tests[$i]/i) {
602 return 1;
603 }
604 }
605 return 0;
606}
607
608sub read_testlist($)
609{
610 my ($filename) = @_;
611
612 my @ret = ();
613 open(IN, $filename) or die("Unable to open $filename: $!");
614
615 while (<IN>) {
616 if ($_ eq "-- TEST --\n") {
617 my $name = <IN>;
618 $name =~ s/\n//g;
619 my $env = <IN>;
620 $env =~ s/\n//g;
621 my $cmdline = <IN>;
622 $cmdline =~ s/\n//g;
623 if (should_run_test($name) == 1) {
624 $required_envs{$env} = 1;
625 push (@ret, [$name, $env, $cmdline]);
626 }
627 } else {
628 print;
629 }
630 }
631 close(IN) or die("Error creating recipe");
632 return @ret;
633}
634
635if ($#testlists == -1) {
636 die("No testlists specified");
637}
638
639$ENV{SELFTEST_PREFIX} = "$prefix_abs";
640if ($opt_socket_wrapper) {
641 $ENV{SELFTEST_INTERFACES} = $interfaces;
642} else {
643 $ENV{SELFTEST_INTERFACES} = "";
644}
645if ($opt_verbose) {
646 $ENV{SELFTEST_VERBOSE} = "1";
647} else {
648 $ENV{SELFTEST_VERBOSE} = "";
649}
650if ($opt_quick) {
651 $ENV{SELFTEST_QUICK} = "1";
652} else {
653 $ENV{SELFTEST_QUICK} = "";
654}
655$ENV{SELFTEST_TARGET} = $opt_target;
656$ENV{SELFTEST_MAXTIME} = $torture_maxtime;
657
658my @available = ();
659foreach my $fn (@testlists) {
660 foreach (read_testlist($fn)) {
661 my $name = $$_[0];
662 next if (@includes and not defined(find_in_list(\@includes, $name)));
663 push (@available, $_);
664 }
665}
666
667Subunit::testsuite_count($#available+1);
668Subunit::report_time(time());
669
670foreach (@available) {
671 my $name = $$_[0];
672 my $skipreason = skip($name);
673 if (defined($skipreason)) {
674 Subunit::skip_testsuite($name, $skipreason);
675 } else {
676 push(@todo, $_);
677 }
678}
679
680if ($#todo == -1) {
681 print STDERR "No tests to run\n";
682 exit(1);
683 }
684
685my $suitestotal = $#todo + 1;
686my $i = 0;
687$| = 1;
688
689my %running_envs = ();
690
691sub get_running_env($)
692{
693 my ($name) = @_;
694
695 my $envname = $name;
696
697 $envname =~ s/:.*//;
698
699 return $running_envs{$envname};
700}
701
702my @exported_envvars = (
703 # domain stuff
704 "DOMAIN",
705 "REALM",
706
707 # domain controller stuff
708 "DC_SERVER",
709 "DC_SERVER_IP",
710 "DC_NETBIOSNAME",
711 "DC_NETBIOSALIAS",
712
713 # server stuff
714 "SERVER",
715 "SERVER_IP",
716 "NETBIOSNAME",
717 "NETBIOSALIAS",
718
719 # user stuff
720 "USERNAME",
721 "PASSWORD",
722 "DC_USERNAME",
723 "DC_PASSWORD",
724
725 # misc stuff
726 "KRB5_CONFIG",
727 "WINBINDD_SOCKET_DIR",
728 "WINBINDD_PRIV_PIPE_DIR"
729);
730
731$SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
732 my $signame = shift;
733 teardown_env($_) foreach(keys %running_envs);
734 die("Received signal $signame");
735};
736
737sub setup_env($)
738{
739 my ($name) = @_;
740
741 my $testenv_vars = undef;
742
743 my $envname = $name;
744 my $option = $name;
745
746 $envname =~ s/:.*//;
747 $option =~ s/^[^:]*//;
748 $option =~ s/^://;
749
750 $option = "client" if $option eq "";
751
752 if ($envname eq "none") {
753 $testenv_vars = {};
754 } elsif (defined(get_running_env($envname))) {
755 $testenv_vars = get_running_env($envname);
756 if (not $target->check_env($testenv_vars)) {
757 $testenv_vars = undef;
758 }
759 } else {
760 $testenv_vars = $target->setup_env($envname, $prefix);
761 }
762
763 return undef unless defined($testenv_vars);
764
765 $running_envs{$envname} = $testenv_vars;
766
767 if ($option eq "local") {
768 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
769 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
770 } elsif ($option eq "client") {
771 SocketWrapper::set_default_iface(6);
772 write_clientconf($conffile, $testenv_vars);
773 $ENV{SMB_CONF_PATH} = $conffile;
774 } else {
775 die("Unknown option[$option] for envname[$envname]");
776 }
777
778 foreach (@exported_envvars) {
779 if (defined($testenv_vars->{$_})) {
780 $ENV{$_} = $testenv_vars->{$_};
781 } else {
782 delete $ENV{$_};
783 }
784 }
785
786 return $testenv_vars;
787}
788
789sub exported_envvars_str($)
790{
791 my ($testenv_vars) = @_;
792 my $out = "";
793
794 foreach (@exported_envvars) {
795 next unless defined($testenv_vars->{$_});
796 $out .= $_."=".$testenv_vars->{$_}."\n";
797 }
798
799 return $out;
800}
801
802sub getlog_env($)
803{
804 my ($envname) = @_;
805 return "" if ($envname eq "none");
806 return $target->getlog_env(get_running_env($envname));
807}
808
809sub check_env($)
810{
811 my ($envname) = @_;
812 return 1 if ($envname eq "none");
813 return $target->check_env(get_running_env($envname));
814}
815
816sub teardown_env($)
817{
818 my ($envname) = @_;
819 return if ($envname eq "none");
820 $target->teardown_env(get_running_env($envname));
821 delete $running_envs{$envname};
822}
823
824if ($opt_no_lazy_setup) {
825 setup_env($_) foreach (keys %required_envs);
826}
827
828if ($opt_testenv) {
829 my $testenv_name = $ENV{SELFTEST_TESTENV};
830 $testenv_name = $testenv_default unless defined($testenv_name);
831
832 my $testenv_vars = setup_env($testenv_name);
833
834 $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
835
836 my $envvarstr = exported_envvars_str($testenv_vars);
837
838 my $term = ($ENV{TERM} or "xterm");
839 system("$term -e 'echo -e \"
840Welcome to the Samba4 Test environment '$testenv_name'
841
842This matches the client environment used in make test
843server is pid `cat \$PIDDIR/samba.pid`
844
845Some useful environment variables:
846TORTURE_OPTIONS=\$TORTURE_OPTIONS
847SMB_CONF_PATH=\$SMB_CONF_PATH
848
849$envvarstr
850\" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
851 teardown_env($testenv_name);
852} else {
853 foreach (@todo) {
854 $i++;
855 my $cmd = $$_[2];
856 $cmd =~ s/([\(\)])/\\$1/g;
857 my $name = $$_[0];
858 my $envname = $$_[1];
859
860 my $envvars = setup_env($envname);
861 if (not defined($envvars)) {
862 Subunit::skip_testsuite($name,
863 "unable to set up environment $envname");
864 next;
865 }
866
867 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
868
869 if (defined($opt_analyse_cmd)) {
870 system("$opt_analyse_cmd \"$name\"");
871 }
872
873 teardown_env($envname) if ($opt_resetup_env);
874 }
875}
876
877print "\n";
878
879teardown_env($_) foreach (keys %running_envs);
880
881$target->stop();
882
883my $failed = 0;
884
885# if there were any valgrind failures, show them
886foreach (<$prefix/valgrind.log*>) {
887 next unless (-s $_);
888 system("grep DWARF2.CFI.reader $_ > /dev/null");
889 if ($? >> 8 == 0) {
890 print "VALGRIND FAILURE\n";
891 $failed++;
892 system("cat $_");
893 }
894}
895exit 0;
Note: See TracBrowser for help on using the repository browser.