Bug 661855 - unique.pl regexpr fix + unit test. r=khuey

This commit is contained in:
Joey Armstrong 2011-06-20 15:38:46 -04:00
Родитель 35d7170e98
Коммит 292a2c1db8
5 изменённых файлов: 375 добавлений и 15 удалений

Просмотреть файл

@ -1,3 +1,4 @@
# -*- makefile -*-
#
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
@ -21,6 +22,7 @@
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
# Joey Armstrong <joey@mozilla.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either of the GNU General Public License Version 2 or later (the "GPL"),
@ -49,7 +51,15 @@ ifdef USE_ELF_HACK
DIRS = elfhack
endif
ifdef ENABLE_TESTS
ifeq (,$(filter WINNT OS2,$(OS_ARCH)))
DIRS += test
endif # WIN
endif # ENABLE_TESTS
include $(topsrcdir)/config/rules.mk
libs:: $(srcdir)/run-mozilla.sh
$(INSTALL) $< $(DIST)/bin
# EOF

Просмотреть файл

@ -0,0 +1,76 @@
# -*- makefile -*-
#
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is mozilla.org code.
#
# The Initial Developer of the Original Code is Mozilla Foundation.
# Portions created by the Initial Developer are Copyright (C) 2011
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
# Joey Armstrong <joey@mozilla.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either of the GNU General Public License Version 2 or later (the "GPL"),
# or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****
DEPTH = ../../..
topsrcdir = @top_srcdir@
srcdir = @srcdir@
VPATH = @srcdir@
include $(DEPTH)/config/autoconf.mk
include $(topsrcdir)/config/rules.mk
##################################################
## Gather a list of tests, generate timestamp deps
##################################################
TS=.ts
ifneq (,$(findstring check,$(MAKECMDGOALS)))
allsrc = $(wildcard $(srcdir)/*)
tests2run = $(notdir $(filter %.tpl,$(allsrc)))
check_targets += $(addprefix $(TS)/,$(tests2run))
endif
check:: $(TS) $(check_targets)
#############################################
# Only invoke tests when sources have changed
#############################################
$(TS)/%: $(srcdir)/%
$(PERL) $(srcdir)/runtest $<
@touch $@
#####################################################
## Extra dep needed to synchronize parallel execution
#####################################################
$(TS): $(TS)/.done
$(TS)/.done:
$(MKDIR) -p $(dir $@)
touch $@
GARBAGE_DIRS += $(TS)
# EOF

88
build/unix/test/runtest Executable file
Просмотреть файл

@ -0,0 +1,88 @@
#!/usr/bin/env perl
###########################################################################
## Intent:
## Test::Harness is a testing wrapper that will process output
## from Test.pm module tests. Sumarize results, report stats
## and exit with overall status for the testing suites.
##
## Run testing suite:
## % make clean test
## % perl runtest
##
## Run Individual tests
## % perl tUtils0
###########################################################################
##----------------------------##
##---] CORE/CPAN INCLUDES [---##
##----------------------------##
use strict;
use warnings;
use Getopt::Long;
use Test::Harness;
##-------------------##
##---] EXPORTS [---##
##-------------------##
our $VERSION = qw(1.0);
use FindBin;
##-------------------##
##---] GLOBALS [---##
##-------------------##
my %argv;
##----------------##
##---] MAIN [---##
##----------------##
unless(GetOptions(\%argv,
qw(debug|d:1)
))
{
print "Usage: $0\n";
print " --debug Enable debug mode\n";
exit 1;
}
my @tests;
########################################
## Gather a list of tests if none passed
########################################
unless (@tests = @ARGV)
{
local *D;
opendir(D, '.');
while($_ = readdir(D)) {
next unless /.t\S+$/;
next if (/\.ts$/);
push(@tests, $_);
}
closedir(D);
}
###############################################
## Glob a list of tests when directories passed
###############################################
my @tmp;
foreach (@tests)
{
local *D;
if (-d $_ && (my $dir = $_))
{
opendir(D, $_) || die "opendir(D) failed: $!";
my @tests = grep(/\.t[^\.\s]+/o, readdir(D));
closedir(D);
push(@tmp, map{ join('/', $dir, $_); } @tests);
} else {
push(@tmp, $_);
}
}
@tests = @tmp;
print "$0: @ARGV\n" if ($argv{debug});
runtests(@tests);
# EOF

151
build/unix/test/uniq.tpl Executable file
Просмотреть файл

@ -0,0 +1,151 @@
#!/usr/bin/env perl
###########################################################################
## Intent: Unit test to verify uniq.pl
###########################################################################
##----------------------------##
##---] CORE/CPAN INCLUDES [---##
##----------------------------##
use strict;
use warnings;
use Cwd;
use Getopt::Long; # GetOptions
use Test;
sub BEGIN { plan tests => 12 }
##-------------------##
##---] EXPORTS [---##
##-------------------##
our $VERSION = qw(1.0);
##------------------##
##---] INCLUDES [---##
##------------------##
use FindBin;
##-------------------##
##---] GLOBALS [---##
##-------------------##
my %argv;
###########################################################################
## Intent: Run the arch command for output
##
## Returns:
## 0 on success
## $? command shell exit status
###########################################################################
sub uniq_pl
{
my $cmd = "perl $FindBin::RealBin/../uniq.pl @_";
print "Running: $cmd\n" if ($argv{debug});
my @tmp = `$cmd 2>&1`;
my @output = map{ split(/\s+/o); } @tmp;
wantarray ? @output : "@output";
} # uniq_pl
###########################################################################
## Intent:
##
## Returns:
## 0 on success
###########################################################################
sub check_uniq
{
print STDERR "Running test: check_uniq\n" if ($argv{debug});
# TODO: improve test, uniq.pl regexpr handling not quite right
my @todo =
(
[ '', qw(a a/b a/b/c) ] => [ qw(a a/b a/b/c) ],
[ '', qw(a/b a a/b/c) ] => [ qw(a/b a a/b/c) ],
[ '', qw(a/b/c a/b a) ] => [ qw(a/b/c a/b a) ],
[ '', qw(a a/b a/b/c a/b a) ] => [ qw(a a/b a/b/c) ], # dup removal
[ '-s', qw(a a/b a/b/c) ] => [ qw(a a/b a/b/c) ],
[ '-s', qw(a/b a a/b/c) ] => [ qw(a a/b a/b/c) ],
[ '-s', qw(a/b/c a/b a) ] => [ qw(a a/b a/b/c) ],
[ '-r', qw(a a/b a/b/c) ] => [ qw(a) ],
[ '-r', qw(a/b a a/b/c) ] => [ qw(a/b a) ],
[ '-r', qw(a/b/c a/b a) ] => [ qw(a/b/c a/b a) ],
[ '-r', qw(. .. a/b ../a aa/bb) ] => [ qw(. .. a/b aa/bb) ],
[ '-r', qw(.. a/b ../a . aa/bb) ] => [ qw(.. a/b . aa/bb) ],
);
my $ct=1;
while (@todo)
{
my ($a, $b) = splice(@todo, 0, 2);
my @args = @{ $a };
my @exp = @{ $b };
my @out = uniq_pl(@args);
# compareExp(\@out, \@exp, 'Failed on line ' . __LINE__ . ", dataset $ct");
if (0 && 7 == $ct)
{
print STDERR "\n";
print STDERR map{ "args> $_\n" }@args;
print STDERR "\n";
print STDERR map{ "exp> $_\n" }@exp;
print STDERR "\n";
print STDERR map{ "out> $_\n" }@out;
}
ok("@out", "@exp", 'Failed on line ' . __LINE__ . ", dataset $ct");
$ct++;
}
} # check_uniq
###########################################################################
## Intent: Smoke tests for the unittests module
###########################################################################
sub smoke
{
print STDERR "Running test: smoke()\n" if ($argv{debug});
} # smoke()
###########################################################################
## Intent: Intitialize global test objects and consts
###########################################################################
sub init
{
print "Running: init()\n" if ($argv{debug});
# testplan(24, 0);
} # init()
##----------------##
##---] MAIN [---##
##----------------##
unless(GetOptions(\%argv,
qw(
debug|d
manual
test=s@
verbose
)))
{
print "USAGE: $0\n";
print " --debug Enable script debug mode\n";
print " --fail Force a testing failure condition\n";
print " --manual Also run disabled tests\n";
print " --smoke Run smoke tests then exit\n";
print " --test Run a list of tests by function name\n";
print " --verbose Enable script verbose mode\n";
exit 1;
}
init();
testbyname(@{ $argv{test} }) if ($argv{test});
smoke();
check_uniq();
ok(1, 0, 'Forced failure by command line arg --fail') if ($argv{fail});
# EOF

Просмотреть файл

@ -22,6 +22,7 @@
#
# Contributor(s):
# Christopher Seawood <cls@seawood.org>
# Joey Armstrong <joey@mozilla.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either of the GNU General Public License Version 2 or later (the "GPL"),
@ -37,27 +38,61 @@
#
# ***** END LICENSE BLOCK *****
use Getopt::Std;
##----------------------------##
##---] CORE/CPAN INCLUDES [---##
##----------------------------##
use strict;
use warnings;
use Getopt::Long;
getopts('rs');
$regexp = 1 if (defined($opt_r));
$sort = 1 if (defined($opt_s));
##-------------------##
##---] EXPORTS [---##
##-------------------##
our $VERSION = qw(1.1);
undef @out;
if ($sort) {
@in = sort @ARGV;
} else {
@in = @ARGV;
##-------------------##
##---] GLOBALS [---##
##-------------------##
my %argv;
unless(GetOptions(\%argv,
qw(debug|d:1
regex|r:1
sort|s:1)))
{
print "Usage: $0\n";
print " --sort Sort list elements early\n";
print " --regex Exclude subdirs by pattern\n";
}
foreach $d (@in) {
if ($regexp) {
$found = 0;
foreach $dir (@out) {
$found++, last if ($d =~ m/^$dir\// || $d eq $dir);
my $debug = $argv{debug} || 0;
my %seen;
my @out;
my @in = ($argv{sort}) ? sort @ARGV : @ARGV;
foreach my $d (@in)
{
next if ($seen{$d}++);
print " arg is $d\n" if ($debug);
if ($argv{regex})
{
my $found = 0;
foreach my $dir (@out)
{
my $dirM = quotemeta($dir);
$found++, last if ($d eq $dir || $d =~ m!^${dirM}\/!);
}
print "Adding $d\n" if ($debug && !$found);
push @out, $d if (!$found);
} else {
push @out, $d if (!grep(/^$d$/, @out));
print "Adding: $d\n" if ($debug);
push(@out, $d);
}
}
print "@out\n"
# EOF