The Tor Browser / file comparison
comparison: build/unix/test/uniq.tpl
build/unix/test/uniq.tpl
- branch
- TOR_BUG_9701
- changeset 10
- ac0c01689b40
equal
deleted
inserted
replaced
| -1:000000000000 | 0:24206f4ffedf |
|---|---|
| 1 #!/usr/bin/env perl | |
| 2 ########################################################################### | |
| 3 ## Intent: Unit test to verify uniq.pl | |
| 4 ########################################################################### | |
| 5 | |
| 6 ##----------------------------## | |
| 7 ##---] CORE/CPAN INCLUDES [---## | |
| 8 ##----------------------------## | |
| 9 use strict; | |
| 10 use warnings; | |
| 11 use Cwd; | |
| 12 use Getopt::Long; # GetOptions | |
| 13 | |
| 14 use Test; | |
| 15 sub BEGIN { plan tests => 12 } | |
| 16 | |
| 17 ##-------------------## | |
| 18 ##---] EXPORTS [---## | |
| 19 ##-------------------## | |
| 20 our $VERSION = qw(1.0); | |
| 21 | |
| 22 ##------------------## | |
| 23 ##---] INCLUDES [---## | |
| 24 ##------------------## | |
| 25 use FindBin; | |
| 26 | |
| 27 ##-------------------## | |
| 28 ##---] GLOBALS [---## | |
| 29 ##-------------------## | |
| 30 my %argv; | |
| 31 | |
| 32 | |
| 33 ########################################################################### | |
| 34 ## Intent: Run the arch command for output | |
| 35 ## | |
| 36 ## Returns: | |
| 37 ## 0 on success | |
| 38 ## $? command shell exit status | |
| 39 ########################################################################### | |
| 40 sub uniq_pl | |
| 41 { | |
| 42 my $cmd = "perl $FindBin::RealBin/../uniq.pl @_"; | |
| 43 print "Running: $cmd\n" if ($argv{debug}); | |
| 44 my @tmp = `$cmd 2>&1`; | |
| 45 my @output = map{ split(/\s+/o); } @tmp; | |
| 46 wantarray ? @output : "@output"; | |
| 47 } # uniq_pl | |
| 48 | |
| 49 ########################################################################### | |
| 50 ## Intent: | |
| 51 ## | |
| 52 ## Returns: | |
| 53 ## 0 on success | |
| 54 ########################################################################### | |
| 55 sub check_uniq | |
| 56 { | |
| 57 print STDERR "Running test: check_uniq\n" if ($argv{debug}); | |
| 58 | |
| 59 # TODO: improve test, uniq.pl regexpr handling not quite right | |
| 60 | |
| 61 my @todo = | |
| 62 ( | |
| 63 [ '', qw(a a/b a/b/c) ] => [ qw(a a/b a/b/c) ], | |
| 64 [ '', qw(a/b a a/b/c) ] => [ qw(a/b a a/b/c) ], | |
| 65 [ '', qw(a/b/c a/b a) ] => [ qw(a/b/c a/b a) ], | |
| 66 | |
| 67 [ '', qw(a a/b a/b/c a/b a) ] => [ qw(a a/b a/b/c) ], # dup removal | |
| 68 | |
| 69 [ '-s', qw(a a/b a/b/c) ] => [ qw(a a/b a/b/c) ], | |
| 70 [ '-s', qw(a/b a a/b/c) ] => [ qw(a a/b a/b/c) ], | |
| 71 [ '-s', qw(a/b/c a/b a) ] => [ qw(a a/b a/b/c) ], | |
| 72 | |
| 73 [ '-r', qw(a a/b a/b/c) ] => [ qw(a) ], | |
| 74 [ '-r', qw(a/b a a/b/c) ] => [ qw(a/b a) ], | |
| 75 [ '-r', qw(a/b/c a/b a) ] => [ qw(a/b/c a/b a) ], | |
| 76 | |
| 77 [ '-r', qw(. .. a/b ../a aa/bb) ] => [ qw(. .. a/b aa/bb) ], | |
| 78 [ '-r', qw(.. a/b ../a . aa/bb) ] => [ qw(.. a/b . aa/bb) ], | |
| 79 ); | |
| 80 | |
| 81 my $ct=1; | |
| 82 while (@todo) | |
| 83 { | |
| 84 my ($a, $b) = splice(@todo, 0, 2); | |
| 85 my @args = @{ $a }; | |
| 86 my @exp = @{ $b }; | |
| 87 | |
| 88 my @out = uniq_pl(@args); | |
| 89 # compareExp(\@out, \@exp, 'Failed on line ' . __LINE__ . ", dataset $ct"); | |
| 90 if (0 && 7 == $ct) | |
| 91 { | |
| 92 print STDERR "\n"; | |
| 93 print STDERR map{ "args> $_\n" }@args; | |
| 94 print STDERR "\n"; | |
| 95 print STDERR map{ "exp> $_\n" }@exp; | |
| 96 print STDERR "\n"; | |
| 97 print STDERR map{ "out> $_\n" }@out; | |
| 98 } | |
| 99 | |
| 100 ok("@out", "@exp", 'Failed on line ' . __LINE__ . ", dataset $ct"); | |
| 101 $ct++; | |
| 102 } | |
| 103 | |
| 104 } # check_uniq | |
| 105 | |
| 106 ########################################################################### | |
| 107 ## Intent: Smoke tests for the unittests module | |
| 108 ########################################################################### | |
| 109 sub smoke | |
| 110 { | |
| 111 print STDERR "Running test: smoke()\n" if ($argv{debug}); | |
| 112 } # smoke() | |
| 113 | |
| 114 ########################################################################### | |
| 115 ## Intent: Intitialize global test objects and consts | |
| 116 ########################################################################### | |
| 117 sub init | |
| 118 { | |
| 119 print "Running: init()\n" if ($argv{debug}); | |
| 120 # testplan(24, 0); | |
| 121 } # init() | |
| 122 | |
| 123 ##----------------## | |
| 124 ##---] MAIN [---## | |
| 125 ##----------------## | |
| 126 unless(GetOptions(\%argv, | |
| 127 qw( | |
| 128 debug|d | |
| 129 manual | |
| 130 test=s@ | |
| 131 verbose | |
| 132 ))) | |
| 133 { | |
| 134 print "USAGE: $0\n"; | |
| 135 print " --debug Enable script debug mode\n"; | |
| 136 print " --fail Force a testing failure condition\n"; | |
| 137 print " --manual Also run disabled tests\n"; | |
| 138 print " --smoke Run smoke tests then exit\n"; | |
| 139 print " --test Run a list of tests by function name\n"; | |
| 140 print " --verbose Enable script verbose mode\n"; | |
| 141 exit 1; | |
| 142 } | |
| 143 | |
| 144 init(); | |
| 145 testbyname(@{ $argv{test} }) if ($argv{test}); | |
| 146 smoke(); | |
| 147 | |
| 148 check_uniq(); | |
| 149 ok(1, 0, 'Forced failure by command line arg --fail') if ($argv{fail}); | |
| 150 | |
| 151 # EOF |
