Skip to content

Commit

Permalink
Item10028: Fixing UIFn sub creation for switchboard entries. Using ev…
Browse files Browse the repository at this point in the history 
…al sub $name is just plain wrong + perltidy + debug cleanup

git-svn-id: http://svn.foswiki.org/branches/Release01x01@9986 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
  • Loading branch information
OlivierRaginel authored and OlivierRaginel committed Nov 15, 2010
1 parent 8851756 commit 7b6d081
Show file tree
Hide file tree
Showing 2 changed files with 62 additions and 57 deletions.
92 changes: 50 additions & 42 deletions UnitTestContrib/test/bin/TestRunner.pl
View file
Expand Up @@ -21,6 +21,7 @@ sub _findRelativeTo {

BEGIN {
$Foswiki::cfg{Engine} = 'Foswiki::Engine::CGI';

# root the tree
my $here = Cwd::abs_path;

Expand All @@ -35,85 +36,90 @@ BEGIN
die "Cannot locate bin/setlib.cfg" unless $root;

$root =~ s{/bin/setlib.cfg$}{};
($root) = $root =~ /^(.*)$/; # untaint
($root) = $root =~ /^(.*)$/; # untaint

unshift @INC, "$root/test/unit";
unshift @INC, "$root/bin";
unshift @INC, "$root/lib";
unshift @INC, "$root/lib/CPAN/lib";
require 'setlib.cfg';
$starting_root = $root;
};
}

use strict;
use Foswiki; # If you take this out then TestRunner.pl will fail on IndigoPerl
use Unit::TestRunner;

my %options;
while (scalar(@ARGV) && $ARGV[0] =~ /^-/) {
$options{shift(@ARGV)} = 1;
while ( scalar(@ARGV) && $ARGV[0] =~ /^-/ ) {
$options{ shift(@ARGV) } = 1;
}

my ($stdout, $stderr, $log); # will be destroyed at the end, if created
if ($options{-log} and not $options{-worker}) {
my ( $stdout, $stderr, $log ); # will be destroyed at the end, if created
if ( $options{-log} and not $options{-worker} ) {
require Unit::Eavesdrop;
my @gmt = gmtime(time());
my @gmt = gmtime( time() );
$gmt[4]++;
$gmt[5] += 1900;
$log = sprintf("%0.4d",$gmt[5]);
for (my $i = 4; $i >= 0; $i--) {
$log .= sprintf("%0.2d", $gmt[$i]);
$log = sprintf( "%0.4d", $gmt[5] );
for ( my $i = 4 ; $i >= 0 ; $i-- ) {
$log .= sprintf( "%0.2d", $gmt[$i] );
}
$log .= '.log';
open(F, ">$log") || die $!;
open( F, ">$log" ) || die $!;
print STDERR "Logging to $log\n";
$stdout = new Unit::Eavesdrop('STDOUT');
$stdout->teeTo(\*F);
$stdout->teeTo( \*F );

# Don't need this, all the required info goes to STDOUT. STDERR is
# really just treated as a black hole (except when debugging)
# $stderr = new Unit::Eavesdrop('STDERR');
# $stderr->teeTo(\*F);
# $stderr = new Unit::Eavesdrop('STDERR');
# $stderr->teeTo(\*F);
}
print STDERR "Options: ",join(' ',keys %options),"\n";
print STDERR "Options: ", join( ' ', keys %options ), "\n";

if (not defined $ENV{FOSWIKI_ASSERTS} or $ENV{FOSWIKI_ASSERTS} eq 'soft') {
print "exporting FOSWIKI_ASSERTS=1 for extra checking; disable by exporting FOSWIKI_ASSERTS=0\n";
if ( not defined $ENV{FOSWIKI_ASSERTS} or $ENV{FOSWIKI_ASSERTS} eq 'soft' ) {
print
"exporting FOSWIKI_ASSERTS=1 for extra checking; disable by exporting FOSWIKI_ASSERTS=0\n";
$ENV{FOSWIKI_ASSERTS} = 1;
}

if ($ENV{FOSWIKI_ASSERTS}) {
if ( $ENV{FOSWIKI_ASSERTS} ) {
print "Assert checking on $ENV{FOSWIKI_ASSERTS}\n";
} else {
}
else {
print "Assert checking off $ENV{FOSWIKI_ASSERTS}\n";
}

if ($options{-clean}) {
if ( $options{-clean} ) {
require File::Path;
my $rmDir = $Foswiki::cfg{DataDir};
opendir( DIR, "$rmDir" );
my @x = grep { s/^(Temp.*)/$rmDir\/$1/ } readdir(DIR);
opendir( my $dataDir, $rmDir ) or die "Can't open directory $rmDir: $!";
my @x = grep { s/^(Temp.*)/$rmDir\/$1/ } readdir($dataDir);
foreach my $x (@x) {
($x) = $x =~ /^(.*)$/;
File::Path::rmtree($x) if ($x);
($x) = $x =~ /^(.*)$/;
File::Path::rmtree($x) if $x;
}
closedir $dataDir;

$rmDir = $Foswiki::cfg{PubDir};
opendir( DIR, "$rmDir" );
@x = grep { s/^(Temp.*)/$rmDir\/$1/ } readdir(DIR);
opendir( my $pubDir, "$rmDir" ) or die "Can't open directory $rmDir: $!";
@x = grep { s/^(Temp.*)/$rmDir\/$1/ } readdir($pubDir);
foreach my $x (@x) {
($x) = $x =~ /^(.*)$/;
File::Path::rmtree($x) if ($x);
($x) = $x =~ /^(.*)$/;
File::Path::rmtree($x) if $x;
}
closedir $pubDir;
}

if (not $options{-worker}) {
testForFiles($Foswiki::cfg{DataDir},'/Temp*');
testForFiles($Foswiki::cfg{PubDir},'/Temp*');
if ( not $options{-worker} ) {
testForFiles( $Foswiki::cfg{DataDir}, '/Temp*' );
testForFiles( $Foswiki::cfg{PubDir}, '/Temp*' );
}

my $testrunner = Unit::TestRunner->new( {TAP => defined($options{-tap})});
my $testrunner = Unit::TestRunner->new( { TAP => defined( $options{-tap} ) } );
my $exit;
if ($options{-worker}) {
if ( $options{-worker} ) {
$exit = $testrunner->worker(@ARGV);
}
else {
Expand All @@ -122,29 +128,31 @@ BEGIN

print STDERR "Run was logged to $log\n" if $options{-log};


Cwd::chdir($starting_root) if ($starting_root);
exit $exit;

sub testForFiles {
my $testDir = shift;
my $pattrn = shift;
my $pattrn = shift;
opendir( DIR, "$testDir" );
my @list = grep { s/^($pattrn)/$testDir\/$1\n/ } readdir(DIR);
die "Please remove @list (or run with the -clean option) to run tests\n" if (scalar(@list));
die "Please remove @list (or run with the -clean option) to run tests\n"
if ( scalar(@list) );
}

#big nasty global function hacked in to give me insta-TAP output
#TODO: move into the testrunner - I've not looked to see if the TestCase knows who is running it
sub TAP {
my ($bool, $mess) = @_;
sub TAP {
my ( $bool, $mess ) = @_;
$testrunner->{number_of_asserts}++;
return unless (defined($options{-tap}));
print ($bool?"ok\n" : "not ok\n");
return unless ( defined( $options{-tap} ) );
print( $bool? "ok\n" : "not ok\n" );
}

sub PRINT_TAP_TOTAL {
#return unless (defined($options{-tap}));
print "1..$testrunner->{number_of_asserts}\n"

#return unless (defined($options{-tap}));
print "1..$testrunner->{number_of_asserts}\n";
}

1;
Expand Down
27 changes: 12 additions & 15 deletions UnitTestContrib/test/unit/UIFnCompileTests.pm
View file
Expand Up @@ -64,20 +64,17 @@ sub fixture_groups {
};
}

my $package = $dispatcher->{package} || 'Foswiki::UI';
my $package = $dispatcher->{package} || 'Foswiki::UI';
eval "require $package" or next;
my $function = $dispatcher->{function};
my $sub = $package . '::' . $function;

#print STDERR "call $sub\n";

eval <<"SUB";
sub $script {
eval "require \$package" if (defined(\$package));
\$UI_FN = \$sub;
\$SCRIPT_NAME = \$script;
}
SUB
die $@ if $@;
my $sub = $package->can($function);

no strict 'refs';
*$script = sub {
$UI_FN = $sub;
$SCRIPT_NAME = $script;
};
use strict 'refs';
}

return \@groups;
Expand Down Expand Up @@ -193,8 +190,8 @@ sub verify_switchboard_function_nonExistantWeb {
our %expected_status = (
compare => 302,
search => 302,
login => 200,
logon => 200,
login => 200,
logon => 200,
);
$this->assert_num_equals(
$expected_status{$SCRIPT_NAME} || 666,
Expand Down

0 comments on commit 7b6d081

Please sign in to comment.