initial commit of file from CVS for e-smith-test on Wed 12 Jul 09:10:30 BST 2023
This commit is contained in:
Brian Read
325
root/sbin/e-smith/quicktest
Normal file
325
root/sbin/e-smith/quicktest
Normal file
@@ -0,0 +1,325 @@
|
||||
#!/usr/bin/perl -w
|
||||
#----------------------------------------------------------------------
|
||||
# Copyright 1999-2003 Mitel Networks Corporation
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the same terms as Perl itself.
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
=head1 NAME
|
||||
|
||||
quicktest - quickly run all tests in the current CVS project
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
quicktest
|
||||
quicktest [files ...] [--verbose]
|
||||
|
||||
quicktest [-d] [--verbose] file
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a little script to let you quickly run your tests while making
|
||||
changes to an existing e-smith RPM project.
|
||||
|
||||
Unless given a specific set of files to run, it will run all .t files
|
||||
and embedded tests in the current CVS project. It allows you to do a
|
||||
quick test of the RPM without having to do much figuring or typing.
|
||||
|
||||
It will also use any perl libraries located in the current CVS
|
||||
project.
|
||||
|
||||
The "current CVS project" is defined by whatever CVS project you're
|
||||
current working directory is in. So if you're sitting in
|
||||
~/devel/e-smith-base/root/usr/ it will assume your project is
|
||||
e-smith-base.
|
||||
|
||||
Emacs backup files, CVS backup files and other temporary and backup
|
||||
files will be automatically skipped.
|
||||
|
||||
All tests will be run with warnings on.
|
||||
|
||||
=head2 Switches
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<-d>
|
||||
|
||||
Tells quicktest to run the test in the debugger. It will gracefully
|
||||
handle embedded tests.
|
||||
|
||||
quicktest -d lib/some/module.pm
|
||||
|
||||
=item B<--verbose>
|
||||
|
||||
With --verbose quicktest will print out all the lines received from
|
||||
the test.
|
||||
|
||||
=back
|
||||
|
||||
=head1 FILES
|
||||
|
||||
CVS/Repository
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mitel Networks Corporation.
|
||||
|
||||
For more information, see http://www.e-smith.org/
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use File::Find;
|
||||
use File::Spec;
|
||||
|
||||
$| = 1;
|
||||
|
||||
open(my $repository, 'CVS/Repository') ||
|
||||
die "Can't find a CVS/Repository to look at: $!";
|
||||
my $path = <$repository>;
|
||||
close $repository;
|
||||
|
||||
my($project) = $path =~ m{^([^/]+)};
|
||||
chomp $project;
|
||||
print STDERR "Testing '$project'\n";
|
||||
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my %Opts = ();
|
||||
GetOptions(\%Opts, 'd', 'verbose');
|
||||
|
||||
my $Verbose = $ENV{HARNESS_VERBOSE} || $Opts{verbose};
|
||||
|
||||
my @names = @ARGV;
|
||||
my @files = map File::Spec->rel2abs($_), @ARGV;
|
||||
|
||||
|
||||
# Go to the top of the project.
|
||||
chomp $path;
|
||||
my $updir = join '/', ('..') x $path =~ tr|/||;
|
||||
chdir $updir if length $updir;
|
||||
|
||||
my $test_dir = 'root/etc/e-smith/tests';
|
||||
die "Can't find $test_dir" unless -d $test_dir;
|
||||
|
||||
chdir $test_dir;
|
||||
@files = map File::Spec->abs2rel($_), @files;
|
||||
|
||||
|
||||
# Use any libraries in this CVS repository. Test::Harness will
|
||||
# automatically apply this to the tests.
|
||||
our $This_Lib =
|
||||
File::Spec->rel2abs('../../../../root/usr/lib/perl5/site_perl');
|
||||
unshift @INC, $This_Lib;
|
||||
|
||||
|
||||
if($Opts{d}) { # debugging
|
||||
die "I need a file to debug.\n" unless @files;
|
||||
die "You can only debug a single program at a time.\n" unless @files == 1;
|
||||
|
||||
my $file = $files[0];
|
||||
my $name = $names[0];
|
||||
warn "Debugging $file\n";
|
||||
my $test_file = _test_file($file);
|
||||
die "There are no tests in $name\n" unless $test_file;
|
||||
system("PERL5LIB=$This_Lib $^X -d $test_file");
|
||||
exit;
|
||||
}
|
||||
|
||||
unless( @files ) {
|
||||
find(sub {
|
||||
if( -d $_ and $_ eq 'CVS' ) {
|
||||
$File::Find::prune = 1;
|
||||
return;
|
||||
}
|
||||
return if /~$/ || /^\.#/;
|
||||
push @files, $File::Find::name if -f $_
|
||||
}, '../../../..'
|
||||
);
|
||||
|
||||
@names = map { (my $name = $_) =~ s[(\.\./){4}root/][]g; $name } @files;
|
||||
}
|
||||
|
||||
{
|
||||
package My::Strap;
|
||||
use Test::Harness::Straps;
|
||||
our @ISA = qw(Test::Harness::Straps);
|
||||
|
||||
sub _display {
|
||||
my($self, $out) = @_;
|
||||
print $self->{_ml}."$out";
|
||||
}
|
||||
|
||||
sub _print {
|
||||
my($self) = shift;
|
||||
print @_;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
### This is using an experimental callback interface in
|
||||
### Test::Harness::Straps so it can print out test results as they
|
||||
### happen. As the interface is experimental, check the changelog
|
||||
### before upgrading Test::Harness::Straps.
|
||||
|
||||
my $s = My::Strap->new;
|
||||
|
||||
my %handlers = (
|
||||
bailout => sub {
|
||||
my($self, $line, $type, $totals) = @_;
|
||||
|
||||
die sprintf "FAILED--Further testing stopped%s\n",
|
||||
$self->{bailout_reason} ? ": $self->{bailout_reason}" : '';
|
||||
},
|
||||
test => sub {
|
||||
my($self, $line, $type, $totals) = @_;
|
||||
my $curr = $totals->{seen};
|
||||
|
||||
if( $totals->{details}[-1]{ok} ) {
|
||||
$self->_display("ok $curr/$totals->{max}") unless $Verbose;
|
||||
}
|
||||
else {
|
||||
$self->_display("NOK $curr") unless $Verbose;
|
||||
}
|
||||
|
||||
if( $curr > $self->{'next'} ) {
|
||||
$self->_print("Test output counter mismatch [test $curr]\n");
|
||||
}
|
||||
elsif( $curr < $self->{'next'} ) {
|
||||
$self->_print("Confused test output: test $curr answered after ".
|
||||
"test ", $self->{next} - 1, "\n");
|
||||
# $self->{'next'} = $curr;
|
||||
}
|
||||
},
|
||||
);
|
||||
|
||||
$s->{callback} = sub {
|
||||
my($self, $line, $type, $totals) = @_;
|
||||
print $line if $Verbose;
|
||||
|
||||
$handlers{$type}->($self, $line, $type, $totals) if $handlers{$type};
|
||||
};
|
||||
|
||||
|
||||
close STDIN; # else tests might hang waiting for input.
|
||||
|
||||
|
||||
# Iterate through each test or file and run that test.
|
||||
# Most of the code herein is for nice formatting.
|
||||
my $all_passing = 1;
|
||||
my $width = _leader_width(@names);
|
||||
$width = 70 if $width > 70;
|
||||
foreach my $idx (0..$#files) {
|
||||
my($file, $name) = ($files[$idx], $names[$idx]);
|
||||
my %result = ();
|
||||
|
||||
my $test_file = _test_file($file);
|
||||
next unless $test_file;
|
||||
|
||||
my($leader, $ml) = _mk_leader($name, $width);
|
||||
print $leader;
|
||||
print "\n" if $Verbose;
|
||||
$s->{_ml} = $ml;
|
||||
|
||||
local $ENV{HARNESS_PERL_SWITCHES} = '-w';
|
||||
%result = $s->analyze_file($test_file);
|
||||
|
||||
$all_passing = 0 unless $result{passing};
|
||||
$s->_display($result{passing} ? 'ok' : 'FAILED');
|
||||
print "\n";
|
||||
}
|
||||
|
||||
if( $all_passing ) {
|
||||
print "All tests successful!\n"
|
||||
}
|
||||
else {
|
||||
print "SOME TESTS FAILED!\n";
|
||||
}
|
||||
|
||||
|
||||
=begin private
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<_test_file>
|
||||
|
||||
my $test_file = _test_file($file);
|
||||
|
||||
Determines this $file is a test or has embedded tests and generates
|
||||
a runable $test_file based on this.
|
||||
|
||||
=cut
|
||||
|
||||
sub _test_file {
|
||||
my $file = shift;
|
||||
|
||||
my $test_file;
|
||||
if( $file =~ /\.t$/ ) {
|
||||
$test_file = $file;
|
||||
}
|
||||
elsif( system("pod2test '$file' > /tmp/embedded$$.t") == 0 ) {
|
||||
$test_file = "/tmp/embedded$$.t";
|
||||
}
|
||||
|
||||
return $test_file;
|
||||
}
|
||||
|
||||
=item B<_mk_leader>
|
||||
|
||||
my($leader, $ml) = _mk_leader($test_file, $width);
|
||||
|
||||
Generates the 't/foo........' $leader for the given $test_file as well
|
||||
as a similar version which will overwrite the current line (by use of
|
||||
\r and such). $ml may be empty if Test::Harness doesn't think you're
|
||||
on TTY.
|
||||
|
||||
The $width is the width of the "yada/blah.." string.
|
||||
|
||||
=cut
|
||||
|
||||
sub _mk_leader {
|
||||
my($te, $width) = @_;
|
||||
chomp($te);
|
||||
$te =~ s/\.\w+$/./;
|
||||
|
||||
if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
|
||||
my $blank = (' ' x 77);
|
||||
my $leader = "$te" . '.' x ($width - length($te));
|
||||
my $ml = "";
|
||||
|
||||
$ml = "\r$blank\r$leader"
|
||||
if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $ENV{HARNESS_VERBOSE};
|
||||
|
||||
return($leader, $ml);
|
||||
}
|
||||
|
||||
=item B<_leader_width>
|
||||
|
||||
my($width) = _leader_width(@test_files);
|
||||
|
||||
Calculates how wide the leader should be based on the length of the
|
||||
longest test name.
|
||||
|
||||
=cut
|
||||
|
||||
sub _leader_width {
|
||||
my $maxlen = 0;
|
||||
my $maxsuflen = 0;
|
||||
foreach (@_) {
|
||||
my $suf = /\.(\w+)$/ ? $1 : '';
|
||||
my $len = length;
|
||||
my $suflen = length $suf;
|
||||
$maxlen = $len if $len > $maxlen;
|
||||
$maxsuflen = $suflen if $suflen > $maxsuflen;
|
||||
}
|
||||
# + 3 : we want three dots between the test name and the "ok"
|
||||
return $maxlen + 3 - $maxsuflen;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=end private
|
||||
|
||||
|
||||
62
root/sbin/e-smith/smoketest
Normal file
62
root/sbin/e-smith/smoketest
Normal file
@@ -0,0 +1,62 @@
|
||||
#!/usr/bin/perl -w
|
||||
#----------------------------------------------------------------------
|
||||
# Copyright 1999-2003 Mitel Networks Corporation
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the same terms as Perl itself.
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
=head1 NAME
|
||||
|
||||
smoketest -- run a smoketest on the SMEServer
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
smoketest <test directory>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This smoketest script walks the given I<test directory> (or
|
||||
F</etc/e-smith/tests> if none is given) looking for test scripts
|
||||
(F<*.t>).
|
||||
|
||||
It runs these tests in turn, through Test::Harness, and generates a
|
||||
simple report telling you whether the tests passed or failed.
|
||||
|
||||
All tests are run from the I<test directory>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mitel Networks Corporation.
|
||||
|
||||
For more information, see http://www.e-smith.org/
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use File::Find;
|
||||
use Test::Harness;
|
||||
|
||||
my $testdir = shift || "/etc/e-smith/tests";
|
||||
die "$testdir is not a directory\n" unless -d $testdir;
|
||||
chdir $testdir or die "Can't chdir into $testdir: $!\n";
|
||||
|
||||
my @tests = ();
|
||||
find \&wanted, '.';
|
||||
# Let's sort to get the order correct
|
||||
|
||||
if( @tests ) {
|
||||
print "Running tests in $testdir.\n";
|
||||
local $ENV{PERL5LIB} = '../../../usr/lib/perl5/site_perl';
|
||||
runtests @tests;
|
||||
}
|
||||
else {
|
||||
warn "No tests found in or below '$testdir'!\n";
|
||||
}
|
||||
|
||||
sub wanted {
|
||||
push @tests, $File::Find::name if /\.t$/;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user