#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 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;
$class->set_config_wrapper;
+ $class->encode_output;
+
my $screen_logger = $RT::Logger->remove( 'screen' );
require Log::Dispatch::Perl;
$RT::Logger->add( Log::Dispatch::Perl->new
}
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'} ) {
};
}
+sub encode_output {
+ my $builder = Test::More->builder;
+ binmode $builder->output, ":encoding(utf8)";
+ binmode $builder->failure_output, ":encoding(utf8)";
+ binmode $builder->todo_output, ":encoding(utf8)";
+}
+
sub bootstrap_db {
my $self = shift;
my %args = @_;
$RT::Handle->InsertSchema;
$RT::Handle->InsertACL unless $db_type eq 'Oracle';
- RT->InitLogging;
+ __init_logging();
__reconnect_rt();
$RT::Handle->InsertInitialData
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 {
+ $filter->(@_) if $filter;
+ # Avoid reporting this anonymous call frame as the source of the warning.
+ goto &$Test_NoWarnings_Catcher;
+ };
+}
+
=head1 UTILITIES
return $obj;
}
+
+sub load_or_create_group {
+ my $self = shift;
+ my $name = shift;
+ my %args = (@_);
+
+ my $group = RT::Group->new( RT->SystemUser );
+ $group->LoadUserDefinedGroup( $name );
+ unless ( $group->id ) {
+ my ($id, $msg) = $group->CreateUserDefinedGroup(
+ Name => $name,
+ );
+ die "$msg" unless $id;
+ }
+
+ if ( $args{Members} ) {
+ my $cur = $group->MembersObj;
+ while ( my $entry = $cur->Next ) {
+ my ($status, $msg) = $entry->Delete;
+ die "$msg" unless $status;
+ }
+
+ foreach my $new ( @{ $args{Members} } ) {
+ my ($status, $msg) = $group->AddMember(
+ ref($new)? $new->id : $new,
+ );
+ die "$msg" unless $status;
+ }
+ }
+
+ return $group;
+}
+
=head2 load_or_create_queue
=cut
if ( my $content = delete $args{'Content'} ) {
$args{'MIMEObj'} = MIME::Entity->build(
- From => $args{'Requestor'},
- Subject => $args{'Subject'},
- Data => $content,
+ From => Encode::encode( "UTF-8", $args{'Requestor'} ),
+ Subject => RT::Interface::Email::EncodeToMIME( String => $args{'Subject'} ),
+ Type => $args{ContentType} // "text/plain",
+ Charset => "UTF-8",
+ Data => Encode::encode( "UTF-8", $content ),
);
}
$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;
$self->run_and_capture(%args);
}
+sub run_validator {
+ my $self = shift;
+ my %args = (check => 1, resolve => 0, force => 1, timeout => 0, @_ );
+
+ my $validator_path = "$RT::SbinPath/rt-validator";
+
+ my $cmd = $validator_path;
+ die "Couldn't find $cmd command" unless -f $cmd;
+
+ my $timeout = delete $args{timeout};
+
+ while( my ($k,$v) = each %args ) {
+ next unless $v;
+ $cmd .= " --$k '$v'";
+ }
+ $cmd .= ' 2>&1';
+
+ require IPC::Open2;
+ my ($child_out, $child_in);
+ my $pid = IPC::Open2::open2($child_out, $child_in, $cmd);
+ close $child_in;
+
+ local $SIG{ALRM} = sub { kill KILL => $pid; die "Timeout!" };
+
+ alarm $timeout if $timeout;
+ my $result = eval { local $/; <$child_out> };
+ warn $@ if $@;
+ close $child_out;
+ waitpid $pid, 0;
+ alarm 0;
+
+ DBIx::SearchBuilder::Record::Cachable->FlushCache
+ if $args{'resolve'};
+
+ return ($?, $result);
+}
+
sub run_and_capture {
my $self = shift;
my %args = @_;
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 Plack::Middleware::Test::StashWarnings;
- my $stashwarnings = Plack::Middleware::Test::StashWarnings->new;
+ my $stashwarnings = Plack::Middleware::Test::StashWarnings->new(
+ $ENV{'RT_TEST_WEB_HANDLER'} && $ENV{'RT_TEST_WEB_HANDLER'} eq 'inline' ? ( verbose => 0 ) : () );
$app = $stashwarnings->wrap($app);
if ($server_opt{basic_auth}) {
# 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;
$path = File::Spec->catfile( @$path ) if ref $path eq 'ARRAY';
- Test::More::diag "reading content of '$path'" if $ENV{'TEST_VERBOSE'};
-
open( my $fh, "<:raw", $path )
or do {
warn "couldn't open file '$path': $!" unless $args{noexist};
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