[Rt-commit] rt branch, 3.8-trunk, updated. rt-3.8.5-300-g9803f6b

Ruslan Zakirov ruz at bestpractical.com
Wed Oct 14 15:35:28 EDT 2009


The branch, 3.8-trunk has been updated
       via  9803f6b7e7a75c188177d876a69ddda68ce14c7b (commit)
       via  ec0256fdb2554218667f7e6243eb926244a20bf5 (commit)
       via  94637640afa1ebf8288b5a4e608d64637c56666f (commit)
      from  d343e18de308e6d3de4856d623450a3000758ac8 (commit)

Summary of changes:
 lib/RT/Test.pm |  148 ++++++++++++++++++++++++++++++++++++++++++++------------
 1 files changed, 117 insertions(+), 31 deletions(-)

- Log -----------------------------------------------------------------
commit 94637640afa1ebf8288b5a4e608d64637c56666f
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Wed Oct 14 14:02:25 2009 +0400

    move standalone related code into start_standalone_server

diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index b072d51..560e5a8 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -118,14 +118,6 @@ BEGIN {
     $dbname = $ENV{RT_TEST_PARALLEL}? "rt3test_$port" : "rt3test";
 };
 
-use RT::Interface::Web::Standalone;
-use Test::HTTP::Server::Simple::StashWarnings;
-use Test::WWW::Mechanize;
-use File::Path 'mkpath';
-
-unshift @RT::Interface::Web::Standalone::ISA, 'Test::HTTP::Server::Simple::StashWarnings';
-sub RT::Interface::Web::Standalone::test_warning_path { "/__test_warnings" }
-
 sub import {
     my $class = shift;
     my %args = @_;
@@ -926,6 +918,16 @@ sub started_ok {
 sub start_standalone_server {
     my $self = shift;
 
+
+    require RT::Interface::Web::Standalone;
+
+    require Test::HTTP::Server::Simple::StashWarnings;
+    unshift @RT::Interface::Web::Standalone::ISA,
+        'Test::HTTP::Server::Simple::StashWarnings';
+    *RT::Interface::Web::Standalone::test_warning_path = sub {
+        "/__test_warnings";
+    };
+
     my $s = RT::Interface::Web::Standalone->new($port);
 
     my $ret = $s->started_ok;

commit ec0256fdb2554218667f7e6243eb926244a20bf5
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Wed Oct 14 14:03:22 2009 +0400

    minor changes in t/

diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index 560e5a8..29d442c 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -54,7 +54,8 @@ use warnings;
 use base 'Test::More';
 
 use Socket;
-use File::Temp;
+use File::Temp qw(tempfile);
+use File::Path qw(mkpath);
 use File::Spec;
 
 our $SKIP_REQUEST_WORK_AROUND = 0;
@@ -75,7 +76,6 @@ wrap 'HTTP::Request::Common::form_data',
 
 
 our @EXPORT = qw(is_empty);
-
 our ($port, $dbname);
 
 =head1 NAME
@@ -940,8 +940,6 @@ sub start_standalone_server {
     return ($ret, RT::Test::Web->new);
 }
 
-use File::Temp qw(tempfile);
-
 sub start_apache_server {
     my $self = shift;
     my $variant = shift || 'mod_perl';

commit 9803f6b7e7a75c188177d876a69ddda68ce14c7b
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Wed Oct 14 23:30:04 2009 +0400

    refactor tests: new tmp dir, Cfg->Set updates file and more
    
    * new central tmp dir under t/tmp
    * tmp dir is not deleted on failures
    * centrall %tmp hash in RT::Test to hold names
      of files
    * set_config_wrapper that wraps RT->Config->Set calls and
      append changes into the test config file, so we can
      catch them in UI by restarting server

diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index 29d442c..c022854 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -77,6 +77,16 @@ wrap 'HTTP::Request::Common::form_data',
 
 our @EXPORT = qw(is_empty);
 our ($port, $dbname);
+our @SERVERS;
+
+my %tmp = (
+    directory => undef,
+    config    => {
+        RT => undef,
+        apache => undef,
+    },
+    mailbox   => undef,
+);
 
 =head1 NAME
 
@@ -131,6 +141,8 @@ sub import {
         $class->builder->no_plan unless $class->builder->has_plan;
     }
 
+    $class->bootstrap_tempdir;
+
     $class->bootstrap_config( %args );
 
     use RT;
@@ -144,6 +156,8 @@ sub import {
 
     $class->bootstrap_plugins( %args );
 
+    $class->set_config_wrapper;
+
     my $screen_logger = $RT::Logger->remove( 'screen' );
     require Log::Dispatch::Perl;
     $RT::Logger->add( Log::Dispatch::Perl->new
@@ -183,13 +197,29 @@ sub db_requires_no_dba {
     return 1 if $db_type eq 'SQLite';
 }
 
-my $config;
-my $mailbox_catcher = File::Temp->new( OPEN => 0, CLEANUP => 0 )->filename;
+sub bootstrap_tempdir {
+    my $self = shift;
+    my $test_file = (
+        File::Spec->rel2abs((caller)[1])
+            =~ m{(?:^|[\\/])t[/\\](.*)}
+    );
+    my $dir_name = File::Spec->rel2abs('t/tmp/'. $test_file);
+    mkpath( $dir_name );
+    return $tmp{'directory'} = File::Temp->newdir(
+        DIR => $dir_name
+    );
+}
+
 sub bootstrap_config {
     my $self = shift;
     my %args = @_;
 
-    $config = File::Temp->new;
+    $tmp{'config'}{'RT'} = File::Spec->catfile(
+        "$tmp{'directory'}", 'RT_SiteConfig.pm'
+    );
+    open my $config, '>', $tmp{'config'}{'RT'}
+        or die "Couldn't open $tmp{'config'}{'RT'}: $!";
+
     print $config qq{
 Set( \$WebPort , $port);
 Set( \$WebBaseURL , "http://localhost:\$WebPort");
@@ -208,12 +238,15 @@ Set( \$MailCommand, 'testfile');
         if $INC{'Devel/Cover.pm'};
 
     # set mail catcher
+    my $mail_catcher = $tmp{'mailbox'} = File::Spec->catfile(
+        $tmp{'directory'}->dirname, 'mailbox.eml'
+    );
     print $config <<END;
 Set( \$MailCommand, sub {
     my \$MIME = shift;
 
-    open my \$handle, '>>', '$mailbox_catcher'
-        or die "Unable to open '$mailbox_catcher' for appending: \$!";
+    open my \$handle, '>>', '$mail_catcher'
+        or die "Unable to open '$mail_catcher' for appending: \$!";
 
     \$MIME->print(\$handle);
     print \$handle "%% split me! %%\n";
@@ -224,12 +257,45 @@ END
     print $config $args{'config'} if $args{'config'};
 
     print $config "\n1;\n";
-    $ENV{'RT_SITE_CONFIG'} = $config->filename;
+    $ENV{'RT_SITE_CONFIG'} = $tmp{'config'}{'RT'};
     close $config;
 
     return $config;
 }
 
+sub set_config_wrapper {
+    my $self = shift;
+
+    my $old_sub = \&RT::Config::Set;
+    *RT::Config::Set = sub {
+        my @caller = caller;
+        if ( ($caller[1]||'') =~ /\.t$/ ) {
+            my ($self, $name) = @_;
+            my $type = $RT::Config::META{$name}->{'Type'} || 'SCALAR';
+            my %sigils = (
+                HASH   => '%',
+                ARRAY  => '@',
+                SCALAR => '$',
+            );
+            my $sigil = $sigils{$type} || $sigils{'SCALAR'};
+            open my $fh, '>>', $tmp{'config'}{'RT'}
+                or die "Couldn't open config file: $!";
+            require Data::Dumper;
+            print $fh
+                "\nSet(${sigil}${name}, \@{"
+                    . Data::Dumper::Dumper([@_[2 .. $#_]])
+                ."}); 1;\n";
+            close $fh;
+
+            if ( @SERVERS ) {
+                warn "you're changing config option in a test file"
+                    ." when server is active";
+            }
+        }
+        return $old_sub->(@_);
+    };
+}
+
 sub bootstrap_db {
     my $self = shift;
     my %args = @_;
@@ -669,7 +735,7 @@ sub mailsent_ok {
 
     my $mailsent = scalar grep /\S/, split /%% split me! %%\n/,
         RT::Test->file_content(
-            $mailbox_catcher,
+            $tmp{'mailbox'},
             'unlink' => 0,
             noexist => 1
         );
@@ -689,14 +755,14 @@ sub fetch_caught_mails {
     my $self = shift;
     return grep /\S/, split /%% split me! %%\n/,
         RT::Test->file_content(
-            $mailbox_catcher,
+            $tmp{'mailbox'},
             'unlink' => 1,
             noexist => 1
         );
 }
 
 sub clean_caught_mails {
-    unlink $mailbox_catcher;
+    unlink $tmp{'mailbox'};
 }
 
 =head2 get_relocatable_dir
@@ -899,7 +965,6 @@ sub trust_gnupg_key {
     return %res;
 }
 
-my @SERVERS;
 sub started_ok {
     my $self = shift;
 
@@ -946,10 +1011,18 @@ sub start_apache_server {
 
     my %info = $self->apache_server_info( variant => $variant );
 
-    my ($log_fh, $log_fn) = tempfile();
-    my $pid_fn = File::Spec->rel2abs( File::Spec->catfile(
-        't', "apache.$$.pid"
-    ) );
+    Test::More::diag(do {
+        open my $fh, '<', $tmp{'config'}{'RT'};
+        local $/;
+        <$fh>
+    });
+
+    my $log_fn = File::Spec->catfile(
+        "$tmp{'directory'}", 'apache.log'
+    );
+    my $pid_fn = File::Spec->catfile(
+        "$tmp{'directory'}", "apache.pid"
+    );
     my $tmpl = File::Spec->rel2abs( File::Spec->catfile(
         't', 'data', 'configs',
         'apache'. $info{'version'} .'+'. $variant .'.conf'
@@ -968,11 +1041,16 @@ sub start_apache_server {
         my $method = 'apache_'.$variant.'_server_options';
         $self->$method( \%info, \%opt );
     }
-    my ($conf_fh, $conf_fn) = $self->process_in_file(
-        in => $tmpl, options => \%opt, out => $tmpl .'.final',
+    $tmp{'config'}{'apache'} = File::Spec->catfile(
+        "$tmp{'directory'}", "apache.conf"
+    );
+    $self->process_in_file(
+        in      => $tmpl, 
+        out     => $tmp{'config'}{'apache'},
+        options => \%opt,
     );
 
-    $self->fork_exec($info{'executable'}, '-f', $conf_fn);
+    $self->fork_exec($info{'executable'}, '-f', $tmp{'config'}{'apache'});
     my $pid = do {
         my $tries = 60;
         while ( !-e $pid_fn ) {
@@ -1149,7 +1227,7 @@ sub process_in_file {
     }
 
     my ($out_fh, $out_conf);
-    if ( $args{'out'} ) {
+    unless ( $args{'out'} ) {
         ($out_fh, $out_conf) = tempfile();
     } else {
         $out_conf = $args{'out'};
@@ -1173,7 +1251,15 @@ END {
 
     RT::Test->stop_server;
 
-    RT::Test->clean_caught_mails;
+    # not success
+    if ( grep !$_, $Test->summary ) {
+        $tmp{'directory'}->unlink_on_destroy(0);
+
+        Test::More::diag(
+            "Some tests failed, tmp directory"
+            ." '$tmp{directory}' is not cleaned"
+        );
+    }
 
     if ( $ENV{RT_TEST_PARALLEL} && $created_new_db ) {
 

-----------------------------------------------------------------------


More information about the Rt-commit mailing list