X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FTest.pm;h=b15c03d2303024a54a765db313e86bc2d9a7dac4;hb=0ea23112cfa0d82738b0f08d60d90579721b7524;hp=0d6da1b9e718393e9a5853b35ca076350e2741e9;hpb=43a06151e47d2c59b833cbd8c26d97865ee850b6;p=freeside.git diff --git a/rt/lib/RT/Test.pm b/rt/lib/RT/Test.pm index 0d6da1b9e..b15c03d23 100644 --- a/rt/lib/RT/Test.pm +++ b/rt/lib/RT/Test.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -51,15 +51,24 @@ package RT::Test; 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, @@ -94,20 +103,27 @@ problem in Perl that hides the top-level optree from L. 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; @@ -131,15 +147,15 @@ sub import { 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; @@ -168,12 +184,15 @@ sub import { } 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); } @@ -280,9 +299,15 @@ Set( \$RTAddressRegexp , qr/^bad_re_that_doesnt_match\$/i); 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'} ) { @@ -409,7 +434,11 @@ sub bootstrap_db { $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(); @@ -417,7 +446,7 @@ sub bootstrap_db { $RT::Handle->InsertSchema; $RT::Handle->InsertACL unless $db_type eq 'Oracle'; - RT->InitLogging; + __init_logging(); __reconnect_rt(); $RT::Handle->InsertInitialData @@ -556,6 +585,13 @@ sub __drop_database { 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; } @@ -592,6 +628,28 @@ sub __disconnect_rt { 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 @@ -651,6 +709,39 @@ sub load_or_create_user { 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 @@ -868,7 +959,7 @@ sub set_rights { $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; @@ -939,6 +1030,43 @@ sub run_mailgate { $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 = @_; @@ -1068,17 +1196,28 @@ sub clean_caught_mails { 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. Cupdir(), '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 @@ -1276,8 +1415,10 @@ sub started_ok { 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."; } @@ -1298,11 +1439,31 @@ sub test_app { 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; @@ -1314,6 +1475,10 @@ sub test_app { } ); } + + close $warn_fh; + $stashwarnings->add_warning( $warnings ) if $warnings; + return $app; } @@ -1346,7 +1511,8 @@ sub start_plack_server { 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); } @@ -1375,6 +1541,8 @@ sub start_inline_server { # 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(@_); @@ -1405,9 +1573,7 @@ sub stop_server { 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; @@ -1481,15 +1647,38 @@ sub fails { 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