]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
treewide: avoid "delete local" construct on hashes
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index f5b3fae43e8219bcb5a758dd0ed8ea5d8b3bfa12..fc32b57fe92fc7d93ed79f2e38ecf58f0f093738 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
                run_script start_script key2sub xsys xsys_e xqx eml_load tick
                have_xapian_compact json_utf8 setup_public_inboxes
                tcp_host_port test_lei lei lei_ok
-               $lei $lei_out $lei_err $lei_opt);
+               $lei_out $lei_err $lei_opt);
        require Test::More;
        my @methods = grep(!/\W/, @Test::More::EXPORT);
        eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
@@ -446,7 +446,8 @@ sub have_xapian_compact () {
 }
 
 our ($err_skip, $lei_opt, $lei_out, $lei_err);
-our $lei = sub {
+# favor lei() or lei_ok() over $lei for new code
+sub lei (@) {
        my ($cmd, $env, $xopt) = @_;
        $lei_out = $lei_err = '';
        if (!ref($cmd)) {
@@ -459,13 +460,16 @@ our $lei = sub {
        $res;
 };
 
-sub lei (@) { $lei->(@_) }
-
 sub lei_ok (@) {
-       my $msg = ref($_[-1]) ? pop(@_) : undef;
+       my $msg = ref($_[-1]) eq 'SCALAR' ? pop(@_) : undef;
+       my $tmpdir = quotemeta(File::Spec->tmpdir);
        # filter out anything that looks like a path name for consistent logs
-       my @msg = grep(!m!\A/!, @_);
-       ok($lei->(@_), "lei @msg". ($msg ? " ($$msg)" : ''));
+       my @msg = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_;
+       for (@msg) {
+               s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/! ||
+                       s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!;
+       }
+       ok(lei(@_), "lei @msg". ($msg ? " ($$msg)" : '')) or diag $lei_err;
 }
 
 sub json_utf8 () {
@@ -476,13 +480,14 @@ sub test_lei {
 SKIP: {
        my ($cb) = pop @_;
        my $test_opt = shift // {};
-       require_git(2.6) or skip('git 2.6+ required for lei test', 2);
+       require_git(2.6, 1) or skip('git 2.6+ required for lei test', 2);
        require_mods(qw(json DBD::SQLite Search::Xapian), 2);
        require PublicInbox::Config;
-       delete local $ENV{XDG_DATA_HOME};
-       delete local $ENV{XDG_CONFIG_HOME};
-       local $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
-       local $ENV{GIT_COMMITTER_NAME} = 'lei user';
+       local %ENV = %ENV;
+       delete $ENV{XDG_DATA_HOME};
+       delete $ENV{XDG_CONFIG_HOME};
+       $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
+       $ENV{GIT_COMMITTER_NAME} = 'lei user';
        my (undef, $fn, $lineno) = caller(0);
        my $t = "$fn:$lineno";
        require PublicInbox::Spawn;
@@ -505,11 +510,11 @@ EOM
                mkdir($xrd, 0700) or BAIL_OUT "mkdir: $!";
                local $ENV{XDG_RUNTIME_DIR} = $xrd;
                $cb->();
-               ok($lei->(qw(daemon-pid)), "daemon-pid after $t");
+               lei_ok(qw(daemon-pid), \"daemon-pid after $t");
                chomp($daemon_pid = $lei_out);
                if ($daemon_pid) {
                        ok(kill(0, $daemon_pid), "daemon running after $t");
-                       ok($lei->(qw(daemon-kill)), "daemon-kill after $t");
+                       lei_ok(qw(daemon-kill), \"daemon-kill after $t");
                } else {
                        fail("daemon not running after $t");
                }
@@ -523,7 +528,7 @@ EOM
                local $ENV{HOME} = $home;
                # force sun_path[108] overflow:
                my $xrd = "$home/1shot-test".('.sun_path' x 108);
-               local $err_skip = qr!\Q$xrd!; # for $lei->() filtering
+               local $err_skip = qr!\Q$xrd!; # for lei() filtering
                local $ENV{XDG_RUNTIME_DIR} = $xrd;
                $cb->();
        }
@@ -540,7 +545,7 @@ EOM
 # returns the pathname to a ~/.public-inbox/config in scalar context,
 # ($test_home, $pi_config_pathname) in list context
 sub setup_public_inboxes () {
-       my $test_home = "t/home1";
+       my $test_home = "t/home2";
        my $pi_config = "$test_home/.public-inbox/config";
        my $stamp = "$test_home/setup-stamp";
        my @ret = ($test_home, $pi_config);
@@ -555,7 +560,7 @@ sub setup_public_inboxes () {
        local $ENV{PI_CONFIG} = $pi_config;
        for my $V (1, 2) {
                run_script([qw(-init), "-V$V", "t$V",
-                               '--newsgroup', "t.$V",
+                               '--newsgroup', "t.v$V",
                                "$test_home/t$V", "http://example.com/t$V",
                                "t$V\@example.com" ]) or BAIL_OUT "init v$V";
        }