diff options
Diffstat (limited to 'unittest/unit.pl')
-rw-r--r-- | unittest/unit.pl | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/unittest/unit.pl b/unittest/unit.pl new file mode 100644 index 00000000000..bc20938309a --- /dev/null +++ b/unittest/unit.pl @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +# Override _command_line in the standard Perl test harness to prevent +# it from using "perl" to run the test scripts. +package MySQL::Straps; +use base qw(Test::Harness::Straps); +sub _command_line { return $_[1] } + +package main; + +use strict; +use Test::Harness; +use File::Find; + +sub run_cmd (@); + +my %dispatch = ( + "run" => \&run_cmd, +); + +=head1 NAME + +unit - Run unit tests in directory + +=head1 SYNOPSIS + + unit run + +=cut + +my $cmd = shift; + +if (defined $cmd && exists $dispatch{$cmd}) { + $dispatch{$cmd}->(@ARGV); +} else { + print "Unknown command", (defined $cmd ? " $cmd" : ""), ".\n"; + print "Available commands are: ", join(", ", keys %dispatch), "\n"; +} + +=head2 run + +Run all unit tests in the current directory and all subdirectories. + +=cut + + +sub _find_test_files (@) { + my @dirs = @_; + my @files; + find sub { + $File::Find::prune = 1 if /^SCCS$/; + push(@files, $File::Find::name) if -x _ && /\.t\z/; + }, @dirs; + return @files; +} + +sub run_cmd (@) { + my @files; + + push(@_, '.') if @_ == 0; + + foreach my $name (@_) { + push(@files, _find_test_files $name) if -d $name; + push(@files, $name) if -f $name; + } + + if (@files > 0) { + # Removing the first './' from the file names + foreach (@files) { s!^\./!! } + + # Install the strap above instead of the default strap + $Test::Harness::Strap = MySQL::Straps->new; + + runtests @files; + } +} + |