#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
use strict;
use warnings;
+BEGIN { $^W = 1 };
use base 'Test::More';
+# We use the Test::NoWarnings catching and reporting functionality, but need to
+# wrap it in our own special handler because of the warn handler installed via
+# RT->InitLogging().
+require Test::NoWarnings;
+
+my $Test_NoWarnings_Catcher = $SIG{__WARN__};
+my $check_warnings_in_end = 1;
+
use Socket;
use File::Temp qw(tempfile);
use File::Path qw(mkpath);
use File::Spec;
-our @EXPORT = qw(is_empty diag parse_mail works fails);
+our @EXPORT = qw(is_empty diag parse_mail works fails plan done_testing);
my %tmp = (
directory => undef,
our $port;
our @SERVERS;
+BEGIN {
+ delete $ENV{$_} for qw/LANGUAGE LC_ALL LC_MESSAGES LANG/;
+ $ENV{LANG} = "C";
+};
+
sub import {
my $class = shift;
my %args = %rttest_opt = @_;
+ $rttest_opt{'nodb'} = $args{'nodb'} = 1 if $^C;
+
# Spit out a plan (if we got one) *before* we load modules
if ( $args{'tests'} ) {
- $class->builder->plan( tests => $args{'tests'} )
+ plan( tests => $args{'tests'} )
unless $args{'tests'} eq 'no_declare';
}
elsif ( exists $args{'tests'} ) {
# do nothing if they say "tests => undef" - let them make the plan
}
elsif ( $args{'skip_all'} ) {
- $class->builder->plan(skip_all => $args{'skip_all'});
+ plan(skip_all => $args{'skip_all'});
}
else {
$class->builder->no_plan unless $class->builder->has_plan;
if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
- $class->bootstrap_db( %args );
-
RT::InitPluginPaths();
+ RT::InitClasses();
+
+ $class->bootstrap_db( %args );
__reconnect_rt()
unless $args{nodb};
- RT::InitClasses();
- RT::InitLogging();
+ __init_logging();
RT->Plugins;
}
Test::More->export_to_level($level);
+ Test::NoWarnings->export_to_level($level);
- # blow away their diag so we can redefine it without warning
+ # Blow away symbols we redefine to avoid warnings.
# better than "no warnings 'redefine'" because we might accidentally
# suppress a mistaken redefinition
no strict 'refs';
delete ${ caller($level) . '::' }{diag};
+ delete ${ caller($level) . '::' }{plan};
+ delete ${ caller($level) . '::' }{done_testing};
__PACKAGE__->export_to_level($level);
}
print $config "Set( \$DatabaseName , '$dbname');\n";
print $config "Set( \$DatabaseUser , 'u${dbname}');\n";
}
+ if ( $ENV{'RT_TEST_DB_HOST'} ) {
+ print $config "Set( \$DatabaseHost , '$ENV{'RT_TEST_DB_HOST'}');\n";
+ }
if ( $args{'plugins'} ) {
print $config "Set( \@Plugins, qw(". join( ' ', @{ $args{'plugins'} } ) .") );\n";
+
+ my $plugin_data = File::Spec->rel2abs("t/data/plugins");
+ print $config qq[\$RT::PluginPath = "$plugin_data";\n];
}
if ( $INC{'Devel/Cover.pm'} ) {
$args{$forceopt}=1;
}
- return if $args{nodb};
+ # Short-circuit the rest of ourselves if we don't want a db
+ if ($args{nodb}) {
+ __drop_database();
+ return;
+ }
my $db_type = RT->Config->Get('DatabaseType');
__create_database();
$RT::Handle->InsertSchema;
$RT::Handle->InsertACL unless $db_type eq 'Oracle';
- RT->InitLogging;
+ __init_logging();
__reconnect_rt();
$RT::Handle->InsertInitialData
RT::Handle->SystemDSN,
$ENV{RT_DBA_USER}, $ENV{RT_DBA_PASSWORD}
);
+
+ # We ignore errors intentionally by not checking the return value of
+ # DropDatabase below, so let's also suppress DBI's printing of errors when
+ # we overzealously drop.
+ local $dbh->{PrintError} = 0;
+ local $dbh->{PrintWarn} = 0;
+
RT::Handle->DropDatabase( $dbh );
$dbh->disconnect if $my_dbh;
}
if DBIx::SearchBuilder::Record::Cachable->can("FlushCache");
}
+sub __init_logging {
+ my $filter;
+ {
+ # We use local to ensure that the $filter we grab is from InitLogging
+ # and not the handler generated by a previous call to this function
+ # itself.
+ local $SIG{__WARN__};
+ RT::InitLogging();
+ $filter = $SIG{__WARN__};
+ }
+ $SIG{__WARN__} = sub {
+ if ($filter) {
+ my $status = $filter->(@_);
+ if ($status and $status eq 'IGNORE') {
+ return; # pretend the bad dream never happened
+ }
+ }
+ # Avoid reporting this anonymous call frame as the source of the warning.
+ goto &$Test_NoWarnings_Catcher;
+ };
+}
+
=head1 UTILITIES
$acl->Limit( FIELD => 'RightName', OPERATOR => '!=', VALUE => 'SuperUser' );
while ( my $ace = $acl->Next ) {
my $obj = $ace->PrincipalObj->Object;
- if ( $obj->isa('RT::Group') && $obj->Type eq 'UserEquiv' && $obj->Instance == RT->Nobody->id ) {
+ if ( $obj->isa('RT::Group') && ($obj->Type||'') eq 'UserEquiv' && $obj->Instance == RT->Nobody->id ) {
next;
}
$ace->Delete;
Takes a path relative to the location of the test file that is being
run and returns a path that takes the invocation path into account.
-e.g. RT::Test::get_relocatable_dir(File::Spec->updir(), 'data', 'emails')
+e.g. C<RT::Test::get_relocatable_dir(File::Spec->updir(), 'data', 'emails')>
+
+Parent directory traversals (C<..> or File::Spec->updir()) are naively
+canonicalized based on the test file path (C<$0>) so that symlinks aren't
+followed. This is the exact opposite behaviour of most filesystems and is
+considered "wrong", however it is necessary for some subsets of tests which are
+symlinked into the testing tree.
=cut
sub get_relocatable_dir {
- (my $volume, my $directories, my $file) = File::Spec->splitpath($0);
- if (File::Spec->file_name_is_absolute($directories)) {
- return File::Spec->catdir($directories, @_);
- } else {
- return File::Spec->catdir(File::Spec->curdir(), $directories, @_);
+ my @directories = File::Spec->splitdir(
+ File::Spec->rel2abs((File::Spec->splitpath($0))[1])
+ );
+ push @directories, File::Spec->splitdir($_) for @_;
+
+ my @clean;
+ for (@directories) {
+ if ($_ eq "..") { pop @clean }
+ elsif ($_ ne ".") { push @clean, $_ }
}
+ return File::Spec->catdir(@clean);
}
=head2 get_relocatable_file
require RT::Test::Web;
- if ($rttest_opt{nodb}) {
- die "you are trying to use a test web server without db, try use noinitialdata => 1 instead";
+ if ($rttest_opt{nodb} and not $rttest_opt{server_ok}) {
+ die "You are trying to use a test web server without a database. "
+ ."You may want noinitialdata => 1 instead. "
+ ."Pass server_ok => 1 if you know what you're doing.";
}
my $self = shift;
my %server_opt = @_;
- require RT::Interface::Web::Handler;
- my $app = RT::Interface::Web::Handler->PSGIApp;
+ my $app;
+
+ my $warnings = "";
+ open( my $warn_fh, ">", \$warnings );
+ local *STDERR = $warn_fh;
+
+ if ($server_opt{variant} and $server_opt{variant} eq 'rt-server') {
+ $app = do {
+ my $file = "$RT::SbinPath/rt-server";
+ my $psgi = do $file;
+ unless ($psgi) {
+ die "Couldn't parse $file: $@" if $@;
+ die "Couldn't do $file: $!" unless defined $psgi;
+ die "Couldn't run $file" unless $psgi;
+ }
+ $psgi;
+ };
+ } else {
+ require RT::Interface::Web::Handler;
+ $app = RT::Interface::Web::Handler->PSGIApp;
+ }
require Plack::Middleware::Test::StashWarnings;
- $app = Plack::Middleware::Test::StashWarnings->wrap($app);
+ my $stashwarnings = Plack::Middleware::Test::StashWarnings->new;
+ $app = $stashwarnings->wrap($app);
if ($server_opt{basic_auth}) {
require Plack::Middleware::Auth::Basic;
}
);
}
+
+ close $warn_fh;
+ $stashwarnings->add_warning( $warnings ) if $warnings;
+
return $app;
}
my $Tester = Test::Builder->new;
$Tester->ok(1, "started plack server ok");
- __reconnect_rt();
+ __reconnect_rt()
+ unless $rttest_opt{nodb};
return ("http://localhost:$port", RT::Test::Web->new);
}
# Clear out squished CSS and JS cache, since it's retained across
# servers, since it's in-process
RT::Interface::Web->ClearSquished;
+ require RT::Interface::Web::Request;
+ RT::Interface::Web::Request->clear_callback_cache;
Test::More::ok(1, "psgi test server ok");
$TEST_APP = $self->test_app(@_);
my $in_end = shift;
return unless @SERVERS;
- my $sig = 'TERM';
- $sig = 'INT' if $ENV{'RT_TEST_WEB_HANDLER'} eq "plack";
- kill $sig, @SERVERS;
+ kill 'TERM', @SERVERS;
foreach my $pid (@SERVERS) {
if ($ENV{RT_TEST_WEB_HANDLER} =~ /^apache/) {
sleep 1 while kill 0, $pid;
Test::More::ok(!$_[0], $_[1] || 'This should fail');
}
+sub plan {
+ my ($cmd, @args) = @_;
+ my $builder = RT::Test->builder;
+
+ if ($cmd eq "skip_all") {
+ $check_warnings_in_end = 0;
+ } elsif ($cmd eq "tests") {
+ # Increment the test count for the warnings check
+ $args[0]++;
+ }
+ $builder->plan($cmd, @args);
+}
+
+sub done_testing {
+ my $builder = RT::Test->builder;
+
+ Test::NoWarnings::had_no_warnings();
+ $check_warnings_in_end = 0;
+
+ $builder->done_testing(@_);
+}
+
END {
my $Test = RT::Test->builder;
return if $Test->{Original_Pid} != $$;
-
# we are in END block and should protect our exit code
# so calls below may call system or kill that clobbers $?
local $?;
+ Test::NoWarnings::had_no_warnings() if $check_warnings_in_end;
+
RT::Test->stop_server(1);
# not success
projects / freeside.git / blobdiff