X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FTest.pm;h=b15c03d2303024a54a765db313e86bc2d9a7dac4;hb=0ea23112cfa0d82738b0f08d60d90579721b7524;hp=3e7c910ecaa83eaf3a2b03986dd822d5ed879263;hpb=0af38652da3b3be7da2d35b048285ef6f2194e1a;p=freeside.git diff --git a/rt/lib/RT/Test.pm b/rt/lib/RT/Test.pm index 3e7c910ec..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; @@ -139,7 +155,7 @@ sub import { __reconnect_rt() unless $args{nodb}; - 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'} ) { @@ -421,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 @@ -603,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 @@ -662,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 @@ -879,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; @@ -950,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 = @_; @@ -1079,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 @@ -1413,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(@_); @@ -1443,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; @@ -1519,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