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