build/unix/test/runtest

Tue, 06 Jan 2015 21:39:09 +0100

author
Michael Schloh von Bennewitz <michael@schloh.com>
date
Tue, 06 Jan 2015 21:39:09 +0100
branch
TOR_BUG_9701
changeset 8
97036ab72558
permissions
-rw-r--r--

Conditionally force memory storage according to privacy.thirdparty.isolate;
This solves Tor bug #9701, complying with disk avoidance documented in
https://www.torproject.org/projects/torbrowser/design/#disk-avoidance.

     1 #!/usr/bin/env perl
     2 ###########################################################################
     3 ## Intent:
     4 ##   Test::Harness is a testing wrapper that will process output
     5 ##   from Test.pm module tests.  Sumarize results, report stats
     6 ##   and exit with overall status for the testing suites.
     7 ##
     8 ## Run testing suite:
     9 ##   % make clean test
    10 ##   % perl runtest
    11 ##
    12 ## Run Individual tests
    13 ##   % perl tUtils0
    14 ###########################################################################
    16 ##----------------------------##
    17 ##---] CORE/CPAN INCLUDES [---##
    18 ##----------------------------##
    19 use strict;
    20 use warnings;
    21 use Getopt::Long;
    23 use Test::Harness;
    25 ##-------------------##
    26 ##---]  EXPORTS  [---##
    27 ##-------------------##
    28 our $VERSION = qw(1.0);
    29 use FindBin;
    31 ##-------------------##
    32 ##---]  GLOBALS  [---##
    33 ##-------------------##
    34 my %argv;
    36 ##----------------##
    37 ##---]  MAIN  [---##
    38 ##----------------##
    39 unless(GetOptions(\%argv,
    40 		  qw(debug|d)
    41 		 ))
    42 {
    43     print "Usage: $0\n";
    44     print "  --debug  Enable debug mode\n";
    45     exit 1;
    46 }
    48 if (2 > $Test::Harness::VERSION)
    49 {
    50     print "Unit tests will not be run, Test::Harness is too old\n"
    51 	if ($argv{debug});
    52     exit 0;
    53 }
    56 my @tests;
    58 ########################################
    59 ## Gather a list of tests if none passed
    60 ########################################
    61 unless (@tests = @ARGV)
    62 {
    63   local *D;
    64     opendir(D, '.');
    65     while($_ = readdir(D)) {
    66 	next unless /.t\S+$/;
    67 	next if (/\.ts$/);
    68 	push(@tests, $_);
    69     }
    70     closedir(D);
    71 }
    73 ###############################################
    74 ## Glob a list of tests when directories passed
    75 ###############################################
    76 my @tmp;
    77 foreach (@tests)
    78 {
    79   local *D;
    80     if (-d $_ && (my $dir = $_))
    81     {
    82         opendir(D, $_) || die "opendir(D) failed: $!";
    83 	my @tests = grep(/\.t[^\.\s]+/o, readdir(D));
    84 	closedir(D);
    85 	push(@tmp, map{ join('/', $dir, $_); } @tests);
    86     } else {
    87         push(@tmp, $_);
    88     }
    89 }
    90 @tests = @tmp;
    92 print "$0: @ARGV\n" if ($argv{debug});
    93 runtests(@tests);
    95 # EOF

mercurial