From: Michael Stapelberg Date: Mon, 10 Oct 2016 19:14:59 +0000 (+0200) Subject: testsuite: use relative paths, set PATH to absolute path X-Git-Tag: 4.13~15^2~9 X-Git-Url: https://git.sur5r.net/?a=commitdiff_plain;h=84e70a19a82eeed387160a75f4ca28717cd5db7a;p=i3%2Fi3 testsuite: use relative paths, set PATH to absolute path This approach works better with autotools, which supports the build directory being complete outside the source tree. --- diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl deleted file mode 100755 index 14c0a15d..00000000 --- a/testcases/complete-run.pl +++ /dev/null @@ -1,454 +0,0 @@ -#!/usr/bin/env perl -# vim:ts=4:sw=4:expandtab -# © 2010 Michael Stapelberg and contributors -package complete_run; -use strict; -use warnings; -use v5.10; -use utf8; -# the following are modules which ship with Perl (>= 5.10): -use Pod::Usage; -use File::Temp qw(tempfile tempdir); -use Getopt::Long; -use POSIX (); -use TAP::Harness; -use TAP::Parser; -use TAP::Parser::Aggregator; -use Time::HiRes qw(time); -use IO::Handle; - -my $dirname; - -BEGIN { - use File::Basename; - use Cwd qw(abs_path); - - # fileparse()[1] contains the directory portion of the specified path. - # See File::Basename(3p) for more details. - $dirname = (fileparse(abs_path($0)))[1]; -} - -# these are shipped with the testsuite -use lib $dirname . 'lib'; -use i3test::Util qw(slurp); -use StartXServer; -use StatusLine; -use TestWorker; -# the following modules are not shipped with Perl -use AnyEvent; -use AnyEvent::Util; -use AnyEvent::Handle; -use AnyEvent::I3 qw(:all); -use X11::XCB::Connection; -use JSON::XS; # AnyEvent::I3 depends on it, too. - -binmode STDOUT, ':utf8'; -binmode STDERR, ':utf8'; - -# Close superfluous file descriptors which were passed by running in a VIM -# subshell or situations like that. -AnyEvent::Util::close_all_fds_except(0, 1, 2); - -# convenience wrapper to write to the log file -my $log; -sub Log { say $log "@_" } - -my %timings; -my $help = 0; -# Number of tests to run in parallel. Important to know how many Xephyr -# instances we need to start (unless @displays are given). Defaults to -# num_cores * 2. -my $parallel = undef; -my @displays = (); -my %options = ( - valgrind => 0, - strace => 0, - xtrace => 0, - coverage => 0, - restart => 0, -); -my $keep_xserver_output = 0; - -my $result = GetOptions( - "coverage-testing" => \$options{coverage}, - "keep-xserver-output" => \$keep_xserver_output, - "valgrind" => \$options{valgrind}, - "strace" => \$options{strace}, - "xtrace" => \$options{xtrace}, - "display=s" => \@displays, - "parallel=i" => \$parallel, - "help|?" => \$help, -); - -pod2usage(-verbose => 2, -exitcode => 0) if $help; - -chdir $dirname or die "Could not chdir into $dirname"; - -# Check for missing executables -my @binaries = qw( - ../i3 - ../i3bar/i3bar - ../i3-config-wizard/i3-config-wizard - ../i3-dump-log/i3-dump-log - ../i3-input/i3-input - ../i3-msg/i3-msg - ../i3-nagbar/i3-nagbar - ); - -foreach my $binary (@binaries) { - die "$binary executable not found, did you run “make”?" unless -e $binary; - die "$binary is not an executable" unless -x $binary; -} - -if ($options{coverage}) { - qx(command -v lcov &> /dev/null); - die "Cannot find lcov needed for coverage testing." if $?; - qx(command -v genhtml &> /dev/null); - die "Cannot find genhtml needed for coverage testing." if $?; - - # clean out the counters that may be left over from previous tests. - qx(lcov -d ../ --zerocounters &> /dev/null); -} - -qx(Xephyr -help 2>&1); -die "Xephyr was not found in your path. Please install Xephyr (xserver-xephyr on Debian)." if $?; - -@displays = split(/,/, join(',', @displays)); -@displays = map { s/ //g; $_ } @displays; - -# 2: get a list of all testcases -my @testfiles = @ARGV; - -# if no files were passed on command line, run all tests from t/ -@testfiles = if @testfiles == 0; - -my $numtests = scalar @testfiles; - -# No displays specified, let’s start some Xephyr instances. -if (@displays == 0) { - @displays = start_xserver($parallel, $numtests, $keep_xserver_output); -} - -# 1: create an output directory for this test-run -my $outdir = "testsuite-"; -$outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime()); -$outdir .= `git describe --tags`; -chomp($outdir); -mkdir($outdir) or die "Could not create $outdir"; -unlink("latest") if -l "latest"; -symlink("$outdir", "latest") or die "Could not symlink latest to $outdir"; - - -# connect to all displays for two reasons: -# 1: check if the display actually works -# 2: keep the connection open so that i3 is not the only client. this prevents -# the X server from exiting -my @single_worker; -for my $display (@displays) { - my $screen; - my $x = X11::XCB::Connection->new(display => $display); - if ($x->has_error) { - die "Could not connect to display $display\n"; - } else { - # start a TestWorker for each display - push @single_worker, worker($display, $x, $outdir, \%options); - } -} - -# Read previous timing information, if available. We will be able to roughly -# predict the test duration and schedule a good order for the tests. -my $timingsjson = slurp('.last_run_timings.json') if -e '.last_run_timings.json'; -%timings = %{decode_json($timingsjson)} if length($timingsjson) > 0; - -# Re-order the files so that those which took the longest time in the previous -# run will be started at the beginning to not delay the whole run longer than -# necessary. -@testfiles = map { $_->[0] } - sort { $b->[1] <=> $a->[1] } - map { [$_, $timings{$_} // 999] } @testfiles; - -# Run 000-load-deps.t first to bail out early when dependencies are missing. -my $loadtest = "t/000-load-deps.t"; -if ((scalar grep { $_ eq $loadtest } @testfiles) > 0) { - @testfiles = ($loadtest, grep { $_ ne $loadtest } @testfiles); -} - -printf("\nRough time estimate for this run: %.2f seconds\n\n", $timings{GLOBAL}) - if exists($timings{GLOBAL}); - -# Forget the old timings, we don’t necessarily run the same set of tests as -# before. Otherwise we would end up with left-overs. -%timings = (GLOBAL => time()); - -my $logfile = "$outdir/complete-run.log"; -open $log, '>', $logfile or die "Could not create '$logfile': $!"; -$log->autoflush(1); -say "Writing logfile to '$logfile'..."; - -# 3: run all tests -my @done; -my $num = @testfiles; -my $harness = TAP::Harness->new({ }); - -my $aggregator = TAP::Parser::Aggregator->new(); -$aggregator->start(); - -status_init(displays => \@displays, tests => $num); - -my $single_cv = AE::cv; - -# We start tests concurrently: For each display, one test gets started. Every -# test starts another test after completing. -for (@single_worker) { - $single_cv->begin; - take_job($_, $single_cv, \@testfiles); -} - -$single_cv->recv; - -$aggregator->stop(); - -# print empty lines to separate failed tests from statuslines -print "\n\n"; - -for (@done) { - my ($test, $output) = @$_; - say "no output for $test" unless $output; - Log "output for $test:"; - Log $output; - # print error messages of failed tests - say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg -} - -# 4: print summary -$harness->summary($aggregator); - -close $log; - -# 5: Save the timings for better scheduling/prediction next run. -$timings{GLOBAL} = time() - $timings{GLOBAL}; -open(my $fh, '>', '.last_run_timings.json'); -print $fh encode_json(\%timings); -close($fh); - -# 6: Print the slowest test files. -my @slowest = map { $_->[0] } - sort { $b->[1] <=> $a->[1] } - map { [$_, $timings{$_}] } - grep { !/^GLOBAL$/ } keys %timings; -say ''; -say 'The slowest tests are:'; -printf("\t%s with %.2f seconds\n", $_, $timings{$_}) - for @slowest[0..($#slowest > 4 ? 4 : $#slowest)]; - -# When we are running precisely one test, print the output. Makes developing -# with a single testcase easier. -if ($numtests == 1) { - say ''; - say 'Test output:'; - say slurp($logfile); -} - -END { cleanup() } - -if ($options{coverage}) { - print("\nGenerating test coverage report...\n"); - qx(lcov -d ../ -b ../ --capture -o latest/i3-coverage.info); - qx(genhtml -o latest/i3-coverage latest/i3-coverage.info); - if ($?) { - print("Could not generate test coverage html. Did you compile i3 with test coverage support?\n"); - } else { - print("Test coverage report generated in latest/i3-coverage\n"); - } -} - -# Report logfiles that match “(Leak|Address)Sanitizer:”. -my @logs_with_leaks; -for my $log (<$outdir/i3-log-for-*>) { - if (slurp($log) =~ /(Leak|Address)Sanitizer:/) { - push @logs_with_leaks, $log; - } -} -if (scalar @logs_with_leaks > 0) { - say "\nThe following test logfiles contain AddressSanitizer or LeakSanitizer reports:"; - for my $log (sort @logs_with_leaks) { - say "\t$log"; - } -} - -exit ($aggregator->failed > 0); - -# -# Takes a test from the beginning of @testfiles and runs it. -# -# The TAP::Parser (which reads the test output) will get called as soon as -# there is some activity on the stdout file descriptor of the test process -# (using an AnyEvent->io watcher). -# -# When a test completes and @done contains $num entries, the $cv condvar gets -# triggered to finish testing. -# -sub take_job { - my ($worker, $cv, $tests) = @_; - - my $test = shift @$tests - or return $cv->end; - - my $display = $worker->{display}; - - Log status($display, "$test: starting"); - $timings{$test} = time(); - worker_next($worker, $test); - - # create a TAP::Parser with an in-memory fh - my $output; - my $parser = TAP::Parser->new({ - source => do { open(my $fh, '<', \$output); $fh }, - }); - - my $ipc = $worker->{ipc}; - - my $w; - $w = AnyEvent->io( - fh => $ipc, - poll => 'r', - cb => sub { - state $tests_completed = 0; - state $partial = ''; - - sysread($ipc, my $buf, 4096) or die "sysread: $!"; - - if ($partial) { - $buf = $partial . $buf; - $partial = ''; - } - - # make sure we feed TAP::Parser complete lines so it doesn't blow up - if (substr($buf, -1, 1) ne "\n") { - my $nl = rindex($buf, "\n"); - if ($nl == -1) { - $partial = $buf; - return; - } - - # strip partial from buffer - $partial = substr($buf, $nl + 1, ''); - } - - # count lines before stripping eof-marker otherwise we might - # end up with for (1 .. 0) { } which would effectivly skip the loop - my $lines = $buf =~ tr/\n//; - my $t_eof = $buf =~ s/^$TestWorker::EOF$//m; - - $output .= $buf; - - for (1 .. $lines) { - my $result = $parser->next; - next unless defined($result); - if ($result->is_test) { - $tests_completed++; - status($display, "$test: [$tests_completed/??] "); - } elsif ($result->is_bailout) { - Log status($display, "$test: BAILOUT"); - status_completed(scalar @done); - say ""; - say "test $test bailed out: " . $result->explanation; - exit 1; - } - } - - return unless $t_eof; - - Log status($display, "$test: finished"); - $timings{$test} = time() - $timings{$test}; - status_completed(scalar @done); - - $aggregator->add($test, $parser); - push @done, [ $test, $output ]; - - undef $w; - take_job($worker, $cv, $tests); - } - ); -} - -sub cleanup { - my $exitcode = $?; - $_->() for our @CLEANUP; - exit $exitcode; -} - -# must be in a begin block because we C above -BEGIN { - $SIG{$_} = sub { - require Carp; Carp::cluck("Caught SIG$_[0]\n"); - cleanup(); - } for qw(INT TERM QUIT KILL PIPE) -} - -__END__ - -=head1 NAME - -complete-run.pl - Run the i3 testsuite - -=head1 SYNOPSIS - -complete-run.pl [files...] - -=head1 EXAMPLE - -To run the whole testsuite on a reasonable number of Xephyr instances (your -running X11 will not be touched), run: - ./complete-run.pl - -To run only a specific test (useful when developing a new feature), run: - ./complete-run t/100-fullscreen.t - -=head1 OPTIONS - -=over 8 - -=item B<--display> - -Specifies which X11 display should be used. Can be specified multiple times and -will parallelize the tests: - - # Run tests on the second X server - ./complete-run.pl -d :1 - - # Run four tests in parallel on some Xephyr servers - ./complete-run.pl -d :1,:2,:3,:4 - -Note that it is not necessary to specify this anymore. If omitted, -complete-run.pl will start (num_cores * 2) Xephyr instances. - -=item B<--valgrind> - -Runs i3 under valgrind to find memory problems. The output will be available in -C. - -=item B<--strace> - -Runs i3 under strace to trace system calls. The output will be available in -C. - -=item B<--xtrace> - -Runs i3 under xtrace to trace X11 requests/replies. The output will be -available in C. - -=item B<--coverage-testing> - -Generates a test coverage report at C. Exits i3 cleanly -during tests (instead of kill -9) to make coverage testing work properly. - -=item B<--parallel> - -Number of Xephyr instances to start (if you don't want to start num_cores * 2 -instances for some reason). - - # Run all tests on a single Xephyr instance - ./complete-run.pl -p 1 - -=back diff --git a/testcases/complete-run.pl.in b/testcases/complete-run.pl.in new file mode 100755 index 00000000..d872bda1 --- /dev/null +++ b/testcases/complete-run.pl.in @@ -0,0 +1,441 @@ +#!/usr/bin/env perl +# vim:ts=4:sw=4:expandtab +# © 2010 Michael Stapelberg and contributors +package complete_run; +use strict; +use warnings; +use v5.10; +use utf8; +# the following are modules which ship with Perl (>= 5.10): +use Pod::Usage; +use File::Temp qw(tempfile tempdir); +use Getopt::Long; +use POSIX (); +use TAP::Harness; +use TAP::Parser; +use TAP::Parser::Aggregator; +use Time::HiRes qw(time); +use IO::Handle; + +# these are shipped with the testsuite +use lib qw(@abs_top_builddir@/testcases/lib @abs_top_srcdir@/testcases/lib); +use i3test::Util qw(slurp); +use StartXServer; +use StatusLine; +use TestWorker; +# the following modules are not shipped with Perl +use AnyEvent; +use AnyEvent::Util; +use AnyEvent::Handle; +use AnyEvent::I3 qw(:all); +use X11::XCB::Connection; +use JSON::XS; # AnyEvent::I3 depends on it, too. + +binmode STDOUT, ':utf8'; +binmode STDERR, ':utf8'; + +# Close superfluous file descriptors which were passed by running in a VIM +# subshell or situations like that. +AnyEvent::Util::close_all_fds_except(0, 1, 2); + +# convenience wrapper to write to the log file +my $log; +sub Log { say $log "@_" } + +my %timings; +my $help = 0; +# Number of tests to run in parallel. Important to know how many Xephyr +# instances we need to start (unless @displays are given). Defaults to +# num_cores * 2. +my $parallel = undef; +my @displays = (); +my %options = ( + valgrind => 0, + strace => 0, + xtrace => 0, + coverage => 0, + restart => 0, +); +my $keep_xserver_output = 0; + +my $result = GetOptions( + "coverage-testing" => \$options{coverage}, + "keep-xserver-output" => \$keep_xserver_output, + "valgrind" => \$options{valgrind}, + "strace" => \$options{strace}, + "xtrace" => \$options{xtrace}, + "display=s" => \@displays, + "parallel=i" => \$parallel, + "help|?" => \$help, +); + +pod2usage(-verbose => 2, -exitcode => 0) if $help; + +# Check for missing executables +my @binaries = qw( + @abs_top_builddir@/i3 + @abs_top_builddir@/i3bar/i3bar + @abs_top_builddir@/i3-config-wizard/i3-config-wizard + @abs_top_builddir@/i3-dump-log/i3-dump-log + @abs_top_builddir@/i3-input/i3-input + @abs_top_builddir@/i3-msg/i3-msg + @abs_top_builddir@/i3-nagbar/i3-nagbar + ); + +foreach my $binary (@binaries) { + die "$binary executable not found, did you run “make”?" unless -e $binary; + die "$binary is not an executable" unless -x $binary; +} + +$ENV{PATH} = join(':', + '@abs_top_builddir@/i3-nagbar', + '@abs_top_builddir@/i3-msg', + '@abs_top_builddir@/i3-input', + '@abs_top_builddir@/i3-dump-log', + '@abs_top_builddir@/i3-config-wizard', + '@abs_top_builddir@/i3bar', + '@abs_top_builddir@', + '@abs_top_srcdir@', + $ENV{PATH}); + +qx(Xephyr -help 2>&1); +die "Xephyr was not found in your path. Please install Xephyr (xserver-xephyr on Debian)." if $?; + +@displays = split(/,/, join(',', @displays)); +@displays = map { s/ //g; $_ } @displays; + +# 2: get a list of all testcases +my @testfiles = @ARGV; + +# if no files were passed on command line, run all tests from t/ +if (scalar @testfiles == 0) { + @testfiles = <@abs_top_srcdir@/testcases/t/*.t> if @testfiles == 0; +} else { + @testfiles = map { + # Fully qualify each specified file if necessary + if (! -e $_) { + $_ = "@abs_top_srcdir@/testcases/$_"; + } + $_ + } @testfiles; +} + +my $numtests = scalar @testfiles; + +# No displays specified, let’s start some Xephyr instances. +if (@displays == 0) { + @displays = start_xserver($parallel, $numtests, $keep_xserver_output); +} + +# 1: create an output directory for this test-run +my $outdir = "testsuite-"; +$outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime()); +$outdir .= `git describe --tags`; +chomp($outdir); +mkdir($outdir) or die "Could not create $outdir"; +unlink("latest") if -l "latest"; +symlink("$outdir", "latest") or die "Could not symlink latest to $outdir"; + + +# connect to all displays for two reasons: +# 1: check if the display actually works +# 2: keep the connection open so that i3 is not the only client. this prevents +# the X server from exiting +my @single_worker; +for my $display (@displays) { + my $screen; + my $x = X11::XCB::Connection->new(display => $display); + if ($x->has_error) { + die "Could not connect to display $display\n"; + } else { + # start a TestWorker for each display + push @single_worker, worker($display, $x, $outdir, \%options); + } +} + +# Read previous timing information, if available. We will be able to roughly +# predict the test duration and schedule a good order for the tests. +my $timingsjson = slurp('.last_run_timings.json') if -e '.last_run_timings.json'; +%timings = %{decode_json($timingsjson)} if length($timingsjson) > 0; + +# Re-order the files so that those which took the longest time in the previous +# run will be started at the beginning to not delay the whole run longer than +# necessary. +@testfiles = map { $_->[0] } + sort { $b->[1] <=> $a->[1] } + map { [$_, $timings{$_} // 999] } @testfiles; + +# Run 000-load-deps.t first to bail out early when dependencies are missing. +my $loadtest = "t/000-load-deps.t"; +if ((scalar grep { $_ eq $loadtest } @testfiles) > 0) { + @testfiles = ($loadtest, grep { $_ ne $loadtest } @testfiles); +} + +printf("\nRough time estimate for this run: %.2f seconds\n\n", $timings{GLOBAL}) + if exists($timings{GLOBAL}); + +# Forget the old timings, we don’t necessarily run the same set of tests as +# before. Otherwise we would end up with left-overs. +%timings = (GLOBAL => time()); + +my $logfile = "$outdir/complete-run.log"; +open $log, '>', $logfile or die "Could not create '$logfile': $!"; +$log->autoflush(1); +say "Writing logfile to '$logfile'..."; + +# 3: run all tests +my @done; +my $num = @testfiles; +my $harness = TAP::Harness->new({ }); + +my $aggregator = TAP::Parser::Aggregator->new(); +$aggregator->start(); + +status_init(displays => \@displays, tests => $num); + +my $single_cv = AE::cv; + +# We start tests concurrently: For each display, one test gets started. Every +# test starts another test after completing. +for (@single_worker) { + $single_cv->begin; + take_job($_, $single_cv, \@testfiles); +} + +$single_cv->recv; + +$aggregator->stop(); + +# print empty lines to separate failed tests from statuslines +print "\n\n"; + +for (@done) { + my ($test, $output) = @$_; + say "no output for $test" unless $output; + Log "output for $test:"; + Log $output; + # print error messages of failed tests + say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg +} + +# 4: print summary +$harness->summary($aggregator); + +close $log; + +# 5: Save the timings for better scheduling/prediction next run. +$timings{GLOBAL} = time() - $timings{GLOBAL}; +open(my $fh, '>', '.last_run_timings.json'); +print $fh encode_json(\%timings); +close($fh); + +# 6: Print the slowest test files. +my @slowest = map { $_->[0] } + sort { $b->[1] <=> $a->[1] } + map { [$_, $timings{$_}] } + grep { !/^GLOBAL$/ } keys %timings; +say ''; +say 'The slowest tests are:'; +printf("\t%s with %.2f seconds\n", $_, $timings{$_}) + for @slowest[0..($#slowest > 4 ? 4 : $#slowest)]; + +# When we are running precisely one test, print the output. Makes developing +# with a single testcase easier. +if ($numtests == 1) { + say ''; + say 'Test output:'; + say slurp($logfile); +} + +END { cleanup() } + +# Report logfiles that match “(Leak|Address)Sanitizer:”. +my @logs_with_leaks; +for my $log (<$outdir/i3-log-for-*>) { + if (slurp($log) =~ /(Leak|Address)Sanitizer:/) { + push @logs_with_leaks, $log; + } +} +if (scalar @logs_with_leaks > 0) { + say "\nThe following test logfiles contain AddressSanitizer or LeakSanitizer reports:"; + for my $log (sort @logs_with_leaks) { + say "\t$log"; + } +} + +exit ($aggregator->failed > 0); + +# +# Takes a test from the beginning of @testfiles and runs it. +# +# The TAP::Parser (which reads the test output) will get called as soon as +# there is some activity on the stdout file descriptor of the test process +# (using an AnyEvent->io watcher). +# +# When a test completes and @done contains $num entries, the $cv condvar gets +# triggered to finish testing. +# +sub take_job { + my ($worker, $cv, $tests) = @_; + + my $test = shift @$tests + or return $cv->end; + + my $display = $worker->{display}; + + Log status($display, "$test: starting"); + $timings{$test} = time(); + worker_next($worker, $test); + + # create a TAP::Parser with an in-memory fh + my $output; + my $parser = TAP::Parser->new({ + source => do { open(my $fh, '<', \$output); $fh }, + }); + + my $ipc = $worker->{ipc}; + + my $w; + $w = AnyEvent->io( + fh => $ipc, + poll => 'r', + cb => sub { + state $tests_completed = 0; + state $partial = ''; + + sysread($ipc, my $buf, 4096) or die "sysread: $!"; + + if ($partial) { + $buf = $partial . $buf; + $partial = ''; + } + + # make sure we feed TAP::Parser complete lines so it doesn't blow up + if (substr($buf, -1, 1) ne "\n") { + my $nl = rindex($buf, "\n"); + if ($nl == -1) { + $partial = $buf; + return; + } + + # strip partial from buffer + $partial = substr($buf, $nl + 1, ''); + } + + # count lines before stripping eof-marker otherwise we might + # end up with for (1 .. 0) { } which would effectivly skip the loop + my $lines = $buf =~ tr/\n//; + my $t_eof = $buf =~ s/^$TestWorker::EOF$//m; + + $output .= $buf; + + for (1 .. $lines) { + my $result = $parser->next; + next unless defined($result); + if ($result->is_test) { + $tests_completed++; + status($display, "$test: [$tests_completed/??] "); + } elsif ($result->is_bailout) { + Log status($display, "$test: BAILOUT"); + status_completed(scalar @done); + say ""; + say "test $test bailed out: " . $result->explanation; + exit 1; + } + } + + return unless $t_eof; + + Log status($display, "$test: finished"); + $timings{$test} = time() - $timings{$test}; + status_completed(scalar @done); + + $aggregator->add($test, $parser); + push @done, [ $test, $output ]; + + undef $w; + take_job($worker, $cv, $tests); + } + ); +} + +sub cleanup { + my $exitcode = $?; + $_->() for our @CLEANUP; + exit $exitcode; +} + +# must be in a begin block because we C above +BEGIN { + $SIG{$_} = sub { + require Carp; Carp::cluck("Caught SIG$_[0]\n"); + cleanup(); + } for qw(INT TERM QUIT KILL PIPE) +} + +__END__ + +=head1 NAME + +complete-run.pl - Run the i3 testsuite + +=head1 SYNOPSIS + +complete-run.pl [files...] + +=head1 EXAMPLE + +To run the whole testsuite on a reasonable number of Xephyr instances (your +running X11 will not be touched), run: + ./complete-run.pl + +To run only a specific test (useful when developing a new feature), run: + ./complete-run t/100-fullscreen.t + +=head1 OPTIONS + +=over 8 + +=item B<--display> + +Specifies which X11 display should be used. Can be specified multiple times and +will parallelize the tests: + + # Run tests on the second X server + ./complete-run.pl -d :1 + + # Run four tests in parallel on some Xephyr servers + ./complete-run.pl -d :1,:2,:3,:4 + +Note that it is not necessary to specify this anymore. If omitted, +complete-run.pl will start (num_cores * 2) Xephyr instances. + +=item B<--valgrind> + +Runs i3 under valgrind to find memory problems. The output will be available in +C. + +=item B<--strace> + +Runs i3 under strace to trace system calls. The output will be available in +C. + +=item B<--xtrace> + +Runs i3 under xtrace to trace X11 requests/replies. The output will be +available in C. + +=item B<--coverage-testing> + +Generates a test coverage report at C. Exits i3 cleanly +during tests (instead of kill -9) to make coverage testing work properly. + +=item B<--parallel> + +Number of Xephyr instances to start (if you don't want to start num_cores * 2 +instances for some reason). + + # Run all tests on a single Xephyr instance + ./complete-run.pl -p 1 + +=back diff --git a/testcases/lib/SocketActivation.pm b/testcases/lib/SocketActivation.pm index b58707a4..53dbb3b6 100644 --- a/testcases/lib/SocketActivation.pm +++ b/testcases/lib/SocketActivation.pm @@ -62,14 +62,6 @@ sub activate_i3 { mkdir $ENV{XDG_RUNTIME_DIR}; } $ENV{DISPLAY} = $args{display}; - $ENV{PATH} = join(':', - '../i3-nagbar', - '../i3-msg', - '../i3-config-wizard', - '../i3bar', - '..', - $ENV{PATH} - ); # We are about to exec, but we did not modify $^F to include $socket # when creating the socket (because the file descriptor could have a @@ -96,7 +88,7 @@ sub activate_i3 { # the interactive signalhandler to make it crash immediately instead. # Also disable logging to SHM since we redirect the logs anyways. # Force Xinerama because we use Xdmx for multi-monitor tests. - my $i3cmd = abs_path("../i3") . q| --shmlog-size=0 --disable-signalhandler --force-xinerama|; + my $i3cmd = q|i3 --shmlog-size=0 --disable-signalhandler --force-xinerama|; if (!$args{validate_config}) { # We only set logging if i3 is actually started, but not if we only # validate the config file. This is to keep logging to a minimum as diff --git a/testcases/lib/TestWorker.pm b/testcases/lib/TestWorker.pm index 6371591f..aee994f7 100644 --- a/testcases/lib/TestWorker.pm +++ b/testcases/lib/TestWorker.pm @@ -125,7 +125,7 @@ sub worker_wait { package main; local $@; - do "./$file"; + do $file; $test->ok(undef, "$@") if $@; # XXX hack, we need to trigger the read watcher once more diff --git a/testcases/lib/i3test.pm b/testcases/lib/i3test.pm deleted file mode 100644 index 98486122..00000000 --- a/testcases/lib/i3test.pm +++ /dev/null @@ -1,916 +0,0 @@ -package i3test; -# vim:ts=4:sw=4:expandtab -use strict; use warnings; - -use File::Temp qw(tmpnam tempfile tempdir); -use Test::Builder; -use X11::XCB::Rect; -use X11::XCB::Window; -use X11::XCB qw(:all); -use AnyEvent::I3; -use List::Util qw(first); -use Time::HiRes qw(sleep); -use Cwd qw(abs_path); -use Scalar::Util qw(blessed); -use SocketActivation; -use i3test::Util qw(slurp); - -use v5.10; - -# preload -use Test::More (); -use Data::Dumper (); - -use Exporter (); -our @EXPORT = qw( - get_workspace_names - get_unused_workspace - fresh_workspace - get_ws_content - get_ws - get_focused - open_empty_con - open_window - open_floating_window - get_dock_clients - cmd - sync_with_i3 - exit_gracefully - workspace_exists - focused_ws - get_socket_path - launch_with_config - get_i3_log - wait_for_event - wait_for_map - wait_for_unmap - $x -); - -=head1 NAME - -i3test - Testcase setup module - -=encoding utf-8 - -=head1 SYNOPSIS - - use i3test; - - my $ws = fresh_workspace; - is_num_children($ws, 0, 'no containers on this workspace yet'); - cmd 'open'; - is_num_children($ws, 1, 'one container after "open"'); - - done_testing; - -=head1 DESCRIPTION - -This module is used in every i3 testcase and takes care of automatically -starting i3 before any test instructions run. It also saves you typing of lots -of boilerplate in every test file. - - -i3test automatically "use"s C, C, C, -C’s C and C so that all of them are available -to you in your testcase. - -See also C (L) -which provides additional test instructions (like C or C). - -=cut - -my $tester = Test::Builder->new(); -my $_cached_socket_path = undef; -my $_sync_window = undef; -my $tmp_socket_path = undef; - -our $x; - -BEGIN { - my $window_count = 0; - sub counter_window { - return $window_count++; - } -} - -my $i3_pid; -my $i3_autostart; - -END { - - # testcases which start i3 manually should always call exit_gracefully - # on their own. Let’s see, whether they really did. - if (! $i3_autostart) { - return unless $i3_pid; - - $tester->ok(undef, 'testcase called exit_gracefully()'); - } - - # don't trigger SIGCHLD handler - local $SIG{CHLD}; - - # From perldoc -v '$?': - # Inside an "END" subroutine $? contains the value - # that is going to be given to "exit()". - # - # Since waitpid sets $?, we need to localize it, - # otherwise TAP would be misinterpreted our return status - local $?; - - # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda - # files are not written) - if ($ENV{COVERAGE} || $ENV{VALGRIND}) { - exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}"); - - } else { - kill(9, $i3_pid) - or $tester->BAIL_OUT("could not kill i3"); - - waitpid $i3_pid, 0; - } -} - -sub import { - my ($class, %args) = @_; - my $pkg = caller; - - $i3_autostart = delete($args{i3_autostart}) // 1; - - my $cv = launch_with_config('-default', dont_block => 1) - if $i3_autostart; - - my $test_more_args = ''; - $test_more_args = join(' ', 'qw(', %args, ')') if keys %args; - local $@; - eval << "__"; -package $pkg; -use Test::More $test_more_args; -use Data::Dumper; -use AnyEvent::I3; -use Time::HiRes qw(sleep); -use i3test::Test; -__ - $tester->BAIL_OUT("$@") if $@; - feature->import(":5.10"); - strict->import; - warnings->import; - - $x ||= i3test::X11->new; - # set the pointer to a predictable position in case a previous test has - # disturbed it - $x->root->warp_pointer(0, 0); - $cv->recv if $i3_autostart; - - @_ = ($class); - goto \&Exporter::import; -} - -=head1 EXPORT - -=head2 wait_for_event($timeout, $callback) - -Waits for the next event and calls the given callback for every event to -determine if this is the event we are waiting for. - -Can be used to wait until a window is mapped, until a ClientMessage is -received, etc. - - wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY }; - -=cut -sub wait_for_event { - my ($timeout, $cb) = @_; - - my $cv = AE::cv; - - $x->flush; - - # unfortunately, there is no constant for this - my $ae_read = 0; - - my $guard = AE::io $x->get_file_descriptor, $ae_read, sub { - while (defined(my $event = $x->poll_for_event)) { - if ($cb->($event)) { - $cv->send(1); - last; - } - } - }; - - # Trigger timeout after $timeout seconds (can be fractional) - my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) }; - - my $result = $cv->recv; - undef $t; - undef $guard; - return $result; -} - -=head2 wait_for_map($window) - -Thin wrapper around wait_for_event which waits for MAP_NOTIFY. -Make sure to include 'structure_notify' in the window’s event_mask attribute. - -This function is called by C, so in most cases, you don’t need to -call it on your own. If you need special setup of the window before mapping, -you might have to map it on your own and use this function: - - my $window = open_window(dont_map => 1); - # Do something special with the window first - # … - - # Now map it and wait until it’s been mapped - $window->map; - wait_for_map($window); - -=cut -sub wait_for_map { - my ($win) = @_; - my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win; - wait_for_event 4, sub { - $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id - }; -} - -=head2 wait_for_unmap($window) - -Wrapper around C which waits for UNMAP_NOTIFY. Also calls -C to make sure i3 also picked up and processed the UnmapNotify -event. - - my $ws = fresh_workspace; - my $window = open_window; - is_num_children($ws, 1, 'one window on workspace'); - $window->unmap; - wait_for_unmap; - is_num_children($ws, 0, 'no more windows on this workspace'); - -=cut -sub wait_for_unmap { - my ($win) = @_; - # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win; - wait_for_event 4, sub { - $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id - }; - sync_with_i3(); -} - -=head2 open_window([ $args ]) - -Opens a new window (see C), maps it, waits until it got mapped -and synchronizes with i3. - -The following arguments can be passed: - -=over 4 - -=item class - -The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with -the WM_CLASS! - -=item rect - -An arrayref with 4 members specifying the initial geometry (position and size) -of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100 -with width=70 and height=50. - -Note that this is entirely irrelevant for tiling windows. - -=item background_color - -The background pixel color of the window, formatted as "#rrggbb", like HTML -color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually -watching the testcases. - -=item event_mask - -An arrayref containing strings which describe the X11 event mask we use for that -window. The default is C<< [ 'structure_notify' ] >>. - -=item name - -The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window -n" with n being replaced by a counter to keep windows apart. - -=item dont_map - -Set to a true value to avoid mapping the window (making it visible). - -=item before_map - -A coderef which is called before the window is mapped (unless C is -true). The freshly created C<$window> is passed as C<$_> and as the first -argument. - -=back - -The default values are equivalent to this call: - - open_window( - class => WINDOW_CLASS_INPUT_OUTPUT - rect => [ 0, 0, 30, 30 ] - background_color => '#c0c0c0' - event_mask => [ 'structure_notify' ] - name => 'Window ' - ); - -Usually, though, calls are simpler: - - my $top_window = open_window; - -To identify the resulting window object in i3 commands, use the id property: - - my $top_window = open_window; - cmd '[id="' . $top_window->id . '"] kill'; - -=cut -sub open_window { - my %args = @_ == 1 ? %{$_[0]} : @_; - - my $dont_map = delete $args{dont_map}; - my $before_map = delete $args{before_map}; - - $args{class} //= WINDOW_CLASS_INPUT_OUTPUT; - $args{rect} //= [ 0, 0, 30, 30 ]; - $args{background_color} //= '#c0c0c0'; - $args{event_mask} //= [ 'structure_notify' ]; - $args{name} //= 'Window ' . counter_window(); - - my $window = $x->root->create_child(%args); - $window->add_hint('input'); - - if ($before_map) { - # TODO: investigate why _create is not needed - $window->_create; - $before_map->($window) for $window; - } - - return $window if $dont_map; - - $window->map; - wait_for_map($window); - return $window; -} - -=head2 open_floating_window([ $args ]) - -Thin wrapper around open_window which sets window_type to -C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating. - -The arguments are the same as those of C. - -=cut -sub open_floating_window { - my %args = @_ == 1 ? %{$_[0]} : @_; - - $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY'); - - return open_window(\%args); -} - -sub open_empty_con { - my ($i3) = @_; - - my $reply = $i3->command('open')->recv; - return $reply->[0]->{id}; -} - -=head2 get_workspace_names() - -Returns an arrayref containing the name of every workspace (regardless of its -output) which currently exists. - - my $workspace_names = get_workspace_names; - is(scalar @$workspace_names, 3, 'three workspaces exist currently'); - -=cut -sub get_workspace_names { - my $i3 = i3(get_socket_path()); - my $tree = $i3->get_tree->recv; - my @outputs = @{$tree->{nodes}}; - my @cons; - for my $output (@outputs) { - next if $output->{name} eq '__i3'; - # get the first CT_CON of each output - my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; - @cons = (@cons, @{$content->{nodes}}); - } - [ map { $_->{name} } @cons ] -} - -=head2 get_unused_workspace - -Returns a workspace name which has not yet been used. See also -C which directly switches to an unused workspace. - - my $ws = get_unused_workspace; - cmd "workspace $ws"; - -=cut -sub get_unused_workspace { - my @names = get_workspace_names(); - my $tmp; - do { $tmp = tmpnam() } while ((scalar grep { $_ eq $tmp } @names) > 0); - $tmp -} - -=head2 fresh_workspace([ $args ]) - -Switches to an unused workspace and returns the name of that workspace. - -Optionally switches to the specified output first. - - my $ws = fresh_workspace; - - # Get a fresh workspace on the second output. - my $ws = fresh_workspace(output => 1); - -=cut -sub fresh_workspace { - my %args = @_; - if (exists($args{output})) { - my $i3 = i3(get_socket_path()); - my $tree = $i3->get_tree->recv; - my $output = first { $_->{name} eq "fake-$args{output}" } - @{$tree->{nodes}}; - die "BUG: Could not find output $args{output}" unless defined($output); - # Get the focused workspace on that output and switch to it. - my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; - my $focused = $content->{focus}->[0]; - my $workspace = first { $_->{id} == $focused } @{$content->{nodes}}; - $workspace = $workspace->{name}; - cmd("workspace $workspace"); - } - - my $unused = get_unused_workspace; - cmd("workspace $unused"); - $unused -} - -=head2 get_ws($workspace) - -Returns the container (from the i3 layout tree) which represents C<$workspace>. - - my $ws = fresh_workspace; - my $ws_con = get_ws($ws); - ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent'); - -Here is an example which counts the number of urgent containers recursively, -starting from the workspace container: - - sub count_urgent { - my ($con) = @_; - - my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}}); - my $urgent = grep { $_->{urgent} } @children; - $urgent += count_urgent($_) for @children; - return $urgent; - } - my $urgent = count_urgent(get_ws($ws)); - is($urgent, 3, "three urgent windows on workspace $ws"); - - -=cut -sub get_ws { - my ($name) = @_; - my $i3 = i3(get_socket_path()); - my $tree = $i3->get_tree->recv; - - my @outputs = @{$tree->{nodes}}; - my @workspaces; - for my $output (@outputs) { - # get the first CT_CON of each output - my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; - @workspaces = (@workspaces, @{$content->{nodes}}); - } - - # as there can only be one workspace with this name, we can safely - # return the first entry - return first { $_->{name} eq $name } @workspaces; -} - -=head2 get_ws_content($workspace) - -Returns the content (== tree, starting from the node of a workspace) -of a workspace. If called in array context, also includes the focus -stack of the workspace. - - my $nodes = get_ws_content($ws); - is(scalar @$nodes, 4, 'there are four containers at workspace-level'); - -Or, in array context: - - my $window = open_window; - my ($nodes, $focus) = get_ws_content($ws); - is($focus->[0], $window->id, 'newly opened window focused'); - -Note that this function does not do recursion for you! It only returns the -containers B. If you want to work with all containers (even -nested ones) on a workspace, you have to use recursion: - - # NB: This function does not count floating windows - sub count_urgent { - my ($nodes) = @_; - - my $urgent = 0; - for my $con (@$nodes) { - $urgent++ if $con->{urgent}; - $urgent += count_urgent($con->{nodes}); - } - - return $urgent; - } - my $nodes = get_ws_content($ws); - my $urgent = count_urgent($nodes); - is($urgent, 3, "three urgent windows on workspace $ws"); - -If you also want to deal with floating windows, you have to use C -instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own. - -=cut -sub get_ws_content { - my ($name) = @_; - my $con = get_ws($name); - return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes}; -} - -=head2 get_focused($workspace) - -Returns the container ID of the currently focused container on C<$workspace>. - -Note that the container ID is B the X11 window ID, so comparing the result -of C with a window's C<< ->{id} >> property does B work. - - my $ws = fresh_workspace; - my $first_window = open_window; - my $first_id = get_focused(); - - my $second_window = open_window; - my $second_id = get_focused(); - - cmd 'focus left'; - - is(get_focused($ws), $first_id, 'second window focused'); - -=cut -sub get_focused { - my ($ws) = @_; - my $con = get_ws($ws); - - my @focused = @{$con->{focus}}; - my $lf; - while (@focused > 0) { - $lf = $focused[0]; - last unless defined($con->{focus}); - @focused = @{$con->{focus}}; - my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}}); - $con = $cons[0]; - } - - return $lf; -} - -=head2 get_dock_clients([ $dockarea ]) - -Returns an array of all dock containers in C<$dockarea> (one of "top" or -"bottom"). If C<$dockarea> is not specified, returns an array of all dock -containers in any dockarea. - - my @docked = get_dock_clients; - is(scalar @docked, 0, 'no dock clients yet'); - -=cut -sub get_dock_clients { - my $which = shift; - - my $tree = i3(get_socket_path())->get_tree->recv; - my @outputs = @{$tree->{nodes}}; - # Children of all dockareas - my @docked; - for my $output (@outputs) { - if (!defined($which)) { - @docked = (@docked, map { @{$_->{nodes}} } - grep { $_->{type} eq 'dockarea' } - @{$output->{nodes}}); - } elsif ($which eq 'top') { - my $first = first { $_->{type} eq 'dockarea' } @{$output->{nodes}}; - @docked = (@docked, @{$first->{nodes}}) if defined($first); - } elsif ($which eq 'bottom') { - my @matching = grep { $_->{type} eq 'dockarea' } @{$output->{nodes}}; - my $last = $matching[-1]; - @docked = (@docked, @{$last->{nodes}}) if defined($last); - } - } - return @docked; -} - -=head2 cmd($command) - -Sends the specified command to i3 and returns the output. - - my $ws = unused_workspace; - cmd "workspace $ws"; - cmd 'focus right'; - -=cut -sub cmd { - i3(get_socket_path())->command(@_)->recv -} - -=head2 workspace_exists($workspace) - -Returns true if C<$workspace> is the name of an existing workspace. - - my $old_ws = focused_ws; - # switch away from where we currently are - fresh_workspace; - - ok(workspace_exists($old_ws), 'old workspace still exists'); - -=cut -sub workspace_exists { - my ($name) = @_; - (scalar grep { $_ eq $name } @{get_workspace_names()}) > 0; -} - -=head2 focused_ws - -Returns the name of the currently focused workspace. - - my $ws = focused_ws; - is($ws, '1', 'i3 starts on workspace 1'); - -=cut -sub focused_ws { - my $i3 = i3(get_socket_path()); - my $tree = $i3->get_tree->recv; - my $focused = $tree->{focus}->[0]; - my $output = first { $_->{id} == $focused } @{$tree->{nodes}}; - my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; - my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}}; - return $first->{name} -} - -=head2 sync_with_i3([ $args ]) - -Sends an I3_SYNC ClientMessage with a random value to the root window. -i3 will reply with the same value, but, due to the order of events it -processes, only after all other events are done. - -This can be used to ensure the results of a cmd 'focus left' are pushed to -X11 and that C<< $x->input_focus >> returns the correct value afterwards. - -See also L for a longer explanation. - - my $window = open_window; - $window->add_hint('urgency'); - # Ensure i3 picked up the change - sync_with_i3; - -The only time when you need to use the C argument is when you just -killed your own X11 connection: - - cmd 'kill client'; - # We need to re-establish the X11 connection which we just killed :). - $x = i3test::X11->new; - sync_with_i3(no_cache => 1); - -=cut -sub sync_with_i3 { - my %args = @_ == 1 ? %{$_[0]} : @_; - - # Since we need a (mapped) window for receiving a ClientMessage, we create - # one on the first call of sync_with_i3. It will be re-used in all - # subsequent calls. - if (!exists($args{window_id}) && - (!defined($_sync_window) || exists($args{no_cache}))) { - $_sync_window = open_window( - rect => [ -15, -15, 10, 10 ], - override_redirect => 1, - ); - } - - my $window_id = delete $args{window_id}; - $window_id //= $_sync_window->id; - - my $root = $x->get_root_window(); - # Generate a random number to identify this particular ClientMessage. - my $myrnd = int(rand(255)) + 1; - - # Generate a ClientMessage, see xcb_client_message_t - my $msg = pack "CCSLLLLLLL", - CLIENT_MESSAGE, # response_type - 32, # format - 0, # sequence - $root, # destination window - $x->atom(name => 'I3_SYNC')->id, - - $window_id, # data[0]: our own window id - $myrnd, # data[1]: a random value to identify the request - 0, - 0, - 0; - - # Send it to the root window -- since i3 uses the SubstructureRedirect - # event mask, it will get the ClientMessage. - $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg); - - return $myrnd if $args{dont_wait_for_event}; - - # now wait until the reply is here - return wait_for_event 4, sub { - my ($event) = @_; - # TODO: const - return 0 unless $event->{response_type} == 161; - - my ($win, $rnd) = unpack "LL", $event->{data}; - return ($rnd == $myrnd); - }; -} - -=head2 exit_gracefully($pid, [ $socketpath ]) - -Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails. - -If C<$socketpath> is not specified, C will be called. - -You only need to use this function if you have launched i3 on your own with -C. Otherwise, it will be automatically called when the -testcase ends. - - use i3test i3_autostart => 0; - my $pid = launch_with_config($config); - # … - exit_gracefully($pid); - -=cut -sub exit_gracefully { - my ($pid, $socketpath) = @_; - $socketpath ||= get_socket_path(); - - my $exited = 0; - eval { - say "Exiting i3 cleanly..."; - i3($socketpath)->command('exit')->recv; - $exited = 1; - }; - - if (!$exited) { - kill(9, $pid) - or $tester->BAIL_OUT("could not kill i3"); - } - - if ($socketpath =~ m,^/tmp/i3-test-socket-,) { - unlink($socketpath); - } - - waitpid $pid, 0; - undef $i3_pid; -} - -=head2 get_socket_path([ $cache ]) - -Gets the socket path from the C atom stored on the X11 root -window. After the first call, this function will return a cached version of the -socket path unless you specify a false value for C<$cache>. - - my $i3 = i3(get_socket_path()); - $i3->command('nop test example')->recv; - -To avoid caching: - - my $i3 = i3(get_socket_path(0)); - -=cut -sub get_socket_path { - my ($cache) = @_; - $cache //= 1; - - if ($cache && defined($_cached_socket_path)) { - return $_cached_socket_path; - } - - my $atom = $x->atom(name => 'I3_SOCKET_PATH'); - my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256); - my $reply = $x->get_property_reply($cookie->{sequence}); - my $socketpath = $reply->{value}; - if ($socketpath eq "/tmp/nested-$ENV{DISPLAY}") { - $socketpath .= '-activation'; - } - $_cached_socket_path = $socketpath; - return $socketpath; -} - -=head2 launch_with_config($config, [ $args ]) - -Launches a new i3 process with C<$config> as configuration file. Useful for -tests which test specific config file directives. - - use i3test i3_autostart => 0; - - my $config = < 1); - - if ($config ne '-default') { - say $fh $config; - } else { - open(my $conf_fh, '<', './i3-test.config') - or $tester->BAIL_OUT("could not open default config: $!"); - local $/; - say $fh scalar <$conf_fh>; - } - - say $fh "ipc-socket $tmp_socket_path" - unless $args{dont_add_socket_path}; - - close($fh); - - my $cv = AnyEvent->condvar; - $i3_pid = activate_i3( - unix_socket_path => "$tmp_socket_path-activation", - display => $ENV{DISPLAY}, - configfile => $tmpfile, - outdir => $ENV{OUTDIR}, - testname => $ENV{TESTNAME}, - valgrind => $ENV{VALGRIND}, - strace => $ENV{STRACE}, - xtrace => $ENV{XTRACE}, - restart => $ENV{RESTART}, - cv => $cv, - dont_create_temp_dir => $args{dont_create_temp_dir}, - validate_config => $args{validate_config}, - ); - - # If we called i3 with -C, we wait for it to exit and then return as - # there's nothing else we need to do. - if ($args{validate_config}) { - $cv->recv; - waitpid $i3_pid, 0; - - # We need this since exit_gracefully will not be called in this case. - undef $i3_pid; - - return ${^CHILD_ERROR_NATIVE}; - } - - # force update of the cached socket path in lib/i3test - # as soon as i3 has started - $cv->cb(sub { get_socket_path(0) }); - - return $cv if $args{dont_block}; - - # blockingly wait until i3 is ready - $cv->recv; - - return $i3_pid; -} - -=head2 get_i3_log - -Returns the content of the log file for the current test. - -=cut -sub get_i3_log { - my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}"; - return slurp($logfile); -} - -=head1 AUTHOR - -Michael Stapelberg - -=cut - -package i3test::X11; -use parent 'X11::XCB::Connection'; - -sub input_focus { - my $self = shift; - i3test::sync_with_i3(); - - return $self->SUPER::input_focus(@_); -} - -1 diff --git a/testcases/lib/i3test.pm.in b/testcases/lib/i3test.pm.in new file mode 100644 index 00000000..f9f6e821 --- /dev/null +++ b/testcases/lib/i3test.pm.in @@ -0,0 +1,916 @@ +package i3test; +# vim:ts=4:sw=4:expandtab +use strict; use warnings; + +use File::Temp qw(tmpnam tempfile tempdir); +use Test::Builder; +use X11::XCB::Rect; +use X11::XCB::Window; +use X11::XCB qw(:all); +use AnyEvent::I3; +use List::Util qw(first); +use Time::HiRes qw(sleep); +use Cwd qw(abs_path); +use Scalar::Util qw(blessed); +use SocketActivation; +use i3test::Util qw(slurp); + +use v5.10; + +# preload +use Test::More (); +use Data::Dumper (); + +use Exporter (); +our @EXPORT = qw( + get_workspace_names + get_unused_workspace + fresh_workspace + get_ws_content + get_ws + get_focused + open_empty_con + open_window + open_floating_window + get_dock_clients + cmd + sync_with_i3 + exit_gracefully + workspace_exists + focused_ws + get_socket_path + launch_with_config + get_i3_log + wait_for_event + wait_for_map + wait_for_unmap + $x +); + +=head1 NAME + +i3test - Testcase setup module + +=encoding utf-8 + +=head1 SYNOPSIS + + use i3test; + + my $ws = fresh_workspace; + is_num_children($ws, 0, 'no containers on this workspace yet'); + cmd 'open'; + is_num_children($ws, 1, 'one container after "open"'); + + done_testing; + +=head1 DESCRIPTION + +This module is used in every i3 testcase and takes care of automatically +starting i3 before any test instructions run. It also saves you typing of lots +of boilerplate in every test file. + + +i3test automatically "use"s C, C, C, +C’s C and C so that all of them are available +to you in your testcase. + +See also C (L) +which provides additional test instructions (like C or C). + +=cut + +my $tester = Test::Builder->new(); +my $_cached_socket_path = undef; +my $_sync_window = undef; +my $tmp_socket_path = undef; + +our $x; + +BEGIN { + my $window_count = 0; + sub counter_window { + return $window_count++; + } +} + +my $i3_pid; +my $i3_autostart; + +END { + + # testcases which start i3 manually should always call exit_gracefully + # on their own. Let’s see, whether they really did. + if (! $i3_autostart) { + return unless $i3_pid; + + $tester->ok(undef, 'testcase called exit_gracefully()'); + } + + # don't trigger SIGCHLD handler + local $SIG{CHLD}; + + # From perldoc -v '$?': + # Inside an "END" subroutine $? contains the value + # that is going to be given to "exit()". + # + # Since waitpid sets $?, we need to localize it, + # otherwise TAP would be misinterpreted our return status + local $?; + + # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda + # files are not written) + if ($ENV{COVERAGE} || $ENV{VALGRIND}) { + exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}"); + + } else { + kill(9, $i3_pid) + or $tester->BAIL_OUT("could not kill i3"); + + waitpid $i3_pid, 0; + } +} + +sub import { + my ($class, %args) = @_; + my $pkg = caller; + + $i3_autostart = delete($args{i3_autostart}) // 1; + + my $cv = launch_with_config('-default', dont_block => 1) + if $i3_autostart; + + my $test_more_args = ''; + $test_more_args = join(' ', 'qw(', %args, ')') if keys %args; + local $@; + eval << "__"; +package $pkg; +use Test::More $test_more_args; +use Data::Dumper; +use AnyEvent::I3; +use Time::HiRes qw(sleep); +use i3test::Test; +__ + $tester->BAIL_OUT("$@") if $@; + feature->import(":5.10"); + strict->import; + warnings->import; + + $x ||= i3test::X11->new; + # set the pointer to a predictable position in case a previous test has + # disturbed it + $x->root->warp_pointer(0, 0); + $cv->recv if $i3_autostart; + + @_ = ($class); + goto \&Exporter::import; +} + +=head1 EXPORT + +=head2 wait_for_event($timeout, $callback) + +Waits for the next event and calls the given callback for every event to +determine if this is the event we are waiting for. + +Can be used to wait until a window is mapped, until a ClientMessage is +received, etc. + + wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY }; + +=cut +sub wait_for_event { + my ($timeout, $cb) = @_; + + my $cv = AE::cv; + + $x->flush; + + # unfortunately, there is no constant for this + my $ae_read = 0; + + my $guard = AE::io $x->get_file_descriptor, $ae_read, sub { + while (defined(my $event = $x->poll_for_event)) { + if ($cb->($event)) { + $cv->send(1); + last; + } + } + }; + + # Trigger timeout after $timeout seconds (can be fractional) + my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) }; + + my $result = $cv->recv; + undef $t; + undef $guard; + return $result; +} + +=head2 wait_for_map($window) + +Thin wrapper around wait_for_event which waits for MAP_NOTIFY. +Make sure to include 'structure_notify' in the window’s event_mask attribute. + +This function is called by C, so in most cases, you don’t need to +call it on your own. If you need special setup of the window before mapping, +you might have to map it on your own and use this function: + + my $window = open_window(dont_map => 1); + # Do something special with the window first + # … + + # Now map it and wait until it’s been mapped + $window->map; + wait_for_map($window); + +=cut +sub wait_for_map { + my ($win) = @_; + my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win; + wait_for_event 4, sub { + $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id + }; +} + +=head2 wait_for_unmap($window) + +Wrapper around C which waits for UNMAP_NOTIFY. Also calls +C to make sure i3 also picked up and processed the UnmapNotify +event. + + my $ws = fresh_workspace; + my $window = open_window; + is_num_children($ws, 1, 'one window on workspace'); + $window->unmap; + wait_for_unmap; + is_num_children($ws, 0, 'no more windows on this workspace'); + +=cut +sub wait_for_unmap { + my ($win) = @_; + # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win; + wait_for_event 4, sub { + $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id + }; + sync_with_i3(); +} + +=head2 open_window([ $args ]) + +Opens a new window (see C), maps it, waits until it got mapped +and synchronizes with i3. + +The following arguments can be passed: + +=over 4 + +=item class + +The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with +the WM_CLASS! + +=item rect + +An arrayref with 4 members specifying the initial geometry (position and size) +of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100 +with width=70 and height=50. + +Note that this is entirely irrelevant for tiling windows. + +=item background_color + +The background pixel color of the window, formatted as "#rrggbb", like HTML +color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually +watching the testcases. + +=item event_mask + +An arrayref containing strings which describe the X11 event mask we use for that +window. The default is C<< [ 'structure_notify' ] >>. + +=item name + +The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window +n" with n being replaced by a counter to keep windows apart. + +=item dont_map + +Set to a true value to avoid mapping the window (making it visible). + +=item before_map + +A coderef which is called before the window is mapped (unless C is +true). The freshly created C<$window> is passed as C<$_> and as the first +argument. + +=back + +The default values are equivalent to this call: + + open_window( + class => WINDOW_CLASS_INPUT_OUTPUT + rect => [ 0, 0, 30, 30 ] + background_color => '#c0c0c0' + event_mask => [ 'structure_notify' ] + name => 'Window ' + ); + +Usually, though, calls are simpler: + + my $top_window = open_window; + +To identify the resulting window object in i3 commands, use the id property: + + my $top_window = open_window; + cmd '[id="' . $top_window->id . '"] kill'; + +=cut +sub open_window { + my %args = @_ == 1 ? %{$_[0]} : @_; + + my $dont_map = delete $args{dont_map}; + my $before_map = delete $args{before_map}; + + $args{class} //= WINDOW_CLASS_INPUT_OUTPUT; + $args{rect} //= [ 0, 0, 30, 30 ]; + $args{background_color} //= '#c0c0c0'; + $args{event_mask} //= [ 'structure_notify' ]; + $args{name} //= 'Window ' . counter_window(); + + my $window = $x->root->create_child(%args); + $window->add_hint('input'); + + if ($before_map) { + # TODO: investigate why _create is not needed + $window->_create; + $before_map->($window) for $window; + } + + return $window if $dont_map; + + $window->map; + wait_for_map($window); + return $window; +} + +=head2 open_floating_window([ $args ]) + +Thin wrapper around open_window which sets window_type to +C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating. + +The arguments are the same as those of C. + +=cut +sub open_floating_window { + my %args = @_ == 1 ? %{$_[0]} : @_; + + $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY'); + + return open_window(\%args); +} + +sub open_empty_con { + my ($i3) = @_; + + my $reply = $i3->command('open')->recv; + return $reply->[0]->{id}; +} + +=head2 get_workspace_names() + +Returns an arrayref containing the name of every workspace (regardless of its +output) which currently exists. + + my $workspace_names = get_workspace_names; + is(scalar @$workspace_names, 3, 'three workspaces exist currently'); + +=cut +sub get_workspace_names { + my $i3 = i3(get_socket_path()); + my $tree = $i3->get_tree->recv; + my @outputs = @{$tree->{nodes}}; + my @cons; + for my $output (@outputs) { + next if $output->{name} eq '__i3'; + # get the first CT_CON of each output + my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; + @cons = (@cons, @{$content->{nodes}}); + } + [ map { $_->{name} } @cons ] +} + +=head2 get_unused_workspace + +Returns a workspace name which has not yet been used. See also +C which directly switches to an unused workspace. + + my $ws = get_unused_workspace; + cmd "workspace $ws"; + +=cut +sub get_unused_workspace { + my @names = get_workspace_names(); + my $tmp; + do { $tmp = tmpnam() } while ((scalar grep { $_ eq $tmp } @names) > 0); + $tmp +} + +=head2 fresh_workspace([ $args ]) + +Switches to an unused workspace and returns the name of that workspace. + +Optionally switches to the specified output first. + + my $ws = fresh_workspace; + + # Get a fresh workspace on the second output. + my $ws = fresh_workspace(output => 1); + +=cut +sub fresh_workspace { + my %args = @_; + if (exists($args{output})) { + my $i3 = i3(get_socket_path()); + my $tree = $i3->get_tree->recv; + my $output = first { $_->{name} eq "fake-$args{output}" } + @{$tree->{nodes}}; + die "BUG: Could not find output $args{output}" unless defined($output); + # Get the focused workspace on that output and switch to it. + my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; + my $focused = $content->{focus}->[0]; + my $workspace = first { $_->{id} == $focused } @{$content->{nodes}}; + $workspace = $workspace->{name}; + cmd("workspace $workspace"); + } + + my $unused = get_unused_workspace; + cmd("workspace $unused"); + $unused +} + +=head2 get_ws($workspace) + +Returns the container (from the i3 layout tree) which represents C<$workspace>. + + my $ws = fresh_workspace; + my $ws_con = get_ws($ws); + ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent'); + +Here is an example which counts the number of urgent containers recursively, +starting from the workspace container: + + sub count_urgent { + my ($con) = @_; + + my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}}); + my $urgent = grep { $_->{urgent} } @children; + $urgent += count_urgent($_) for @children; + return $urgent; + } + my $urgent = count_urgent(get_ws($ws)); + is($urgent, 3, "three urgent windows on workspace $ws"); + + +=cut +sub get_ws { + my ($name) = @_; + my $i3 = i3(get_socket_path()); + my $tree = $i3->get_tree->recv; + + my @outputs = @{$tree->{nodes}}; + my @workspaces; + for my $output (@outputs) { + # get the first CT_CON of each output + my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; + @workspaces = (@workspaces, @{$content->{nodes}}); + } + + # as there can only be one workspace with this name, we can safely + # return the first entry + return first { $_->{name} eq $name } @workspaces; +} + +=head2 get_ws_content($workspace) + +Returns the content (== tree, starting from the node of a workspace) +of a workspace. If called in array context, also includes the focus +stack of the workspace. + + my $nodes = get_ws_content($ws); + is(scalar @$nodes, 4, 'there are four containers at workspace-level'); + +Or, in array context: + + my $window = open_window; + my ($nodes, $focus) = get_ws_content($ws); + is($focus->[0], $window->id, 'newly opened window focused'); + +Note that this function does not do recursion for you! It only returns the +containers B. If you want to work with all containers (even +nested ones) on a workspace, you have to use recursion: + + # NB: This function does not count floating windows + sub count_urgent { + my ($nodes) = @_; + + my $urgent = 0; + for my $con (@$nodes) { + $urgent++ if $con->{urgent}; + $urgent += count_urgent($con->{nodes}); + } + + return $urgent; + } + my $nodes = get_ws_content($ws); + my $urgent = count_urgent($nodes); + is($urgent, 3, "three urgent windows on workspace $ws"); + +If you also want to deal with floating windows, you have to use C +instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own. + +=cut +sub get_ws_content { + my ($name) = @_; + my $con = get_ws($name); + return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes}; +} + +=head2 get_focused($workspace) + +Returns the container ID of the currently focused container on C<$workspace>. + +Note that the container ID is B the X11 window ID, so comparing the result +of C with a window's C<< ->{id} >> property does B work. + + my $ws = fresh_workspace; + my $first_window = open_window; + my $first_id = get_focused(); + + my $second_window = open_window; + my $second_id = get_focused(); + + cmd 'focus left'; + + is(get_focused($ws), $first_id, 'second window focused'); + +=cut +sub get_focused { + my ($ws) = @_; + my $con = get_ws($ws); + + my @focused = @{$con->{focus}}; + my $lf; + while (@focused > 0) { + $lf = $focused[0]; + last unless defined($con->{focus}); + @focused = @{$con->{focus}}; + my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}}); + $con = $cons[0]; + } + + return $lf; +} + +=head2 get_dock_clients([ $dockarea ]) + +Returns an array of all dock containers in C<$dockarea> (one of "top" or +"bottom"). If C<$dockarea> is not specified, returns an array of all dock +containers in any dockarea. + + my @docked = get_dock_clients; + is(scalar @docked, 0, 'no dock clients yet'); + +=cut +sub get_dock_clients { + my $which = shift; + + my $tree = i3(get_socket_path())->get_tree->recv; + my @outputs = @{$tree->{nodes}}; + # Children of all dockareas + my @docked; + for my $output (@outputs) { + if (!defined($which)) { + @docked = (@docked, map { @{$_->{nodes}} } + grep { $_->{type} eq 'dockarea' } + @{$output->{nodes}}); + } elsif ($which eq 'top') { + my $first = first { $_->{type} eq 'dockarea' } @{$output->{nodes}}; + @docked = (@docked, @{$first->{nodes}}) if defined($first); + } elsif ($which eq 'bottom') { + my @matching = grep { $_->{type} eq 'dockarea' } @{$output->{nodes}}; + my $last = $matching[-1]; + @docked = (@docked, @{$last->{nodes}}) if defined($last); + } + } + return @docked; +} + +=head2 cmd($command) + +Sends the specified command to i3 and returns the output. + + my $ws = unused_workspace; + cmd "workspace $ws"; + cmd 'focus right'; + +=cut +sub cmd { + i3(get_socket_path())->command(@_)->recv +} + +=head2 workspace_exists($workspace) + +Returns true if C<$workspace> is the name of an existing workspace. + + my $old_ws = focused_ws; + # switch away from where we currently are + fresh_workspace; + + ok(workspace_exists($old_ws), 'old workspace still exists'); + +=cut +sub workspace_exists { + my ($name) = @_; + (scalar grep { $_ eq $name } @{get_workspace_names()}) > 0; +} + +=head2 focused_ws + +Returns the name of the currently focused workspace. + + my $ws = focused_ws; + is($ws, '1', 'i3 starts on workspace 1'); + +=cut +sub focused_ws { + my $i3 = i3(get_socket_path()); + my $tree = $i3->get_tree->recv; + my $focused = $tree->{focus}->[0]; + my $output = first { $_->{id} == $focused } @{$tree->{nodes}}; + my $content = first { $_->{type} eq 'con' } @{$output->{nodes}}; + my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}}; + return $first->{name} +} + +=head2 sync_with_i3([ $args ]) + +Sends an I3_SYNC ClientMessage with a random value to the root window. +i3 will reply with the same value, but, due to the order of events it +processes, only after all other events are done. + +This can be used to ensure the results of a cmd 'focus left' are pushed to +X11 and that C<< $x->input_focus >> returns the correct value afterwards. + +See also L for a longer explanation. + + my $window = open_window; + $window->add_hint('urgency'); + # Ensure i3 picked up the change + sync_with_i3; + +The only time when you need to use the C argument is when you just +killed your own X11 connection: + + cmd 'kill client'; + # We need to re-establish the X11 connection which we just killed :). + $x = i3test::X11->new; + sync_with_i3(no_cache => 1); + +=cut +sub sync_with_i3 { + my %args = @_ == 1 ? %{$_[0]} : @_; + + # Since we need a (mapped) window for receiving a ClientMessage, we create + # one on the first call of sync_with_i3. It will be re-used in all + # subsequent calls. + if (!exists($args{window_id}) && + (!defined($_sync_window) || exists($args{no_cache}))) { + $_sync_window = open_window( + rect => [ -15, -15, 10, 10 ], + override_redirect => 1, + ); + } + + my $window_id = delete $args{window_id}; + $window_id //= $_sync_window->id; + + my $root = $x->get_root_window(); + # Generate a random number to identify this particular ClientMessage. + my $myrnd = int(rand(255)) + 1; + + # Generate a ClientMessage, see xcb_client_message_t + my $msg = pack "CCSLLLLLLL", + CLIENT_MESSAGE, # response_type + 32, # format + 0, # sequence + $root, # destination window + $x->atom(name => 'I3_SYNC')->id, + + $window_id, # data[0]: our own window id + $myrnd, # data[1]: a random value to identify the request + 0, + 0, + 0; + + # Send it to the root window -- since i3 uses the SubstructureRedirect + # event mask, it will get the ClientMessage. + $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg); + + return $myrnd if $args{dont_wait_for_event}; + + # now wait until the reply is here + return wait_for_event 4, sub { + my ($event) = @_; + # TODO: const + return 0 unless $event->{response_type} == 161; + + my ($win, $rnd) = unpack "LL", $event->{data}; + return ($rnd == $myrnd); + }; +} + +=head2 exit_gracefully($pid, [ $socketpath ]) + +Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails. + +If C<$socketpath> is not specified, C will be called. + +You only need to use this function if you have launched i3 on your own with +C. Otherwise, it will be automatically called when the +testcase ends. + + use i3test i3_autostart => 0; + my $pid = launch_with_config($config); + # … + exit_gracefully($pid); + +=cut +sub exit_gracefully { + my ($pid, $socketpath) = @_; + $socketpath ||= get_socket_path(); + + my $exited = 0; + eval { + say "Exiting i3 cleanly..."; + i3($socketpath)->command('exit')->recv; + $exited = 1; + }; + + if (!$exited) { + kill(9, $pid) + or $tester->BAIL_OUT("could not kill i3"); + } + + if ($socketpath =~ m,^/tmp/i3-test-socket-,) { + unlink($socketpath); + } + + waitpid $pid, 0; + undef $i3_pid; +} + +=head2 get_socket_path([ $cache ]) + +Gets the socket path from the C atom stored on the X11 root +window. After the first call, this function will return a cached version of the +socket path unless you specify a false value for C<$cache>. + + my $i3 = i3(get_socket_path()); + $i3->command('nop test example')->recv; + +To avoid caching: + + my $i3 = i3(get_socket_path(0)); + +=cut +sub get_socket_path { + my ($cache) = @_; + $cache //= 1; + + if ($cache && defined($_cached_socket_path)) { + return $_cached_socket_path; + } + + my $atom = $x->atom(name => 'I3_SOCKET_PATH'); + my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256); + my $reply = $x->get_property_reply($cookie->{sequence}); + my $socketpath = $reply->{value}; + if ($socketpath eq "/tmp/nested-$ENV{DISPLAY}") { + $socketpath .= '-activation'; + } + $_cached_socket_path = $socketpath; + return $socketpath; +} + +=head2 launch_with_config($config, [ $args ]) + +Launches a new i3 process with C<$config> as configuration file. Useful for +tests which test specific config file directives. + + use i3test i3_autostart => 0; + + my $config = < 1); + + if ($config ne '-default') { + say $fh $config; + } else { + open(my $conf_fh, '<', '@abs_top_srcdir@/testcases/i3-test.config') + or $tester->BAIL_OUT("could not open default config: $!"); + local $/; + say $fh scalar <$conf_fh>; + } + + say $fh "ipc-socket $tmp_socket_path" + unless $args{dont_add_socket_path}; + + close($fh); + + my $cv = AnyEvent->condvar; + $i3_pid = activate_i3( + unix_socket_path => "$tmp_socket_path-activation", + display => $ENV{DISPLAY}, + configfile => $tmpfile, + outdir => $ENV{OUTDIR}, + testname => $ENV{TESTNAME}, + valgrind => $ENV{VALGRIND}, + strace => $ENV{STRACE}, + xtrace => $ENV{XTRACE}, + restart => $ENV{RESTART}, + cv => $cv, + dont_create_temp_dir => $args{dont_create_temp_dir}, + validate_config => $args{validate_config}, + ); + + # If we called i3 with -C, we wait for it to exit and then return as + # there's nothing else we need to do. + if ($args{validate_config}) { + $cv->recv; + waitpid $i3_pid, 0; + + # We need this since exit_gracefully will not be called in this case. + undef $i3_pid; + + return ${^CHILD_ERROR_NATIVE}; + } + + # force update of the cached socket path in lib/i3test + # as soon as i3 has started + $cv->cb(sub { get_socket_path(0) }); + + return $cv if $args{dont_block}; + + # blockingly wait until i3 is ready + $cv->recv; + + return $i3_pid; +} + +=head2 get_i3_log + +Returns the content of the log file for the current test. + +=cut +sub get_i3_log { + my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}"; + return slurp($logfile); +} + +=head1 AUTHOR + +Michael Stapelberg + +=cut + +package i3test::X11; +use parent 'X11::XCB::Connection'; + +sub input_focus { + my $self = shift; + i3test::sync_with_i3(); + + return $self->SUPER::input_focus(@_); +} + +1 diff --git a/testcases/t/171-config-migrate.t b/testcases/t/171-config-migrate.t index d098ae58..5bd21128 100644 --- a/testcases/t/171-config-migrate.t +++ b/testcases/t/171-config-migrate.t @@ -29,7 +29,7 @@ sub migrate_config { print $fh $config; close($fh); - my $cmd = "sh -c 'exec " . abs_path("../i3-migrate-config-to-v4") . " --v3 <$tmpfile'"; + my $cmd = "sh -c 'exec i3-migrate-config-to-v4 --v3 <$tmpfile'"; return [ split /\n/, qx($cmd) ]; } diff --git a/testcases/t/187-commands-parser.t b/testcases/t/187-commands-parser.t index 73c443f9..dc5b67ed 100644 --- a/testcases/t/187-commands-parser.t +++ b/testcases/t/187-commands-parser.t @@ -25,7 +25,7 @@ sub parser_calls { # TODO: use a timeout, so that we can error out if it doesn’t terminate # TODO: better way of passing arguments - my $stdout = qx(../test.commands_parser '$command' 2>&1 >&-); + my $stdout = qx(test.commands_parser '$command' 2>&1 >&-); # Filter out all debugging output. my @lines = split("\n", $stdout); diff --git a/testcases/t/196-randr-output-names.t b/testcases/t/196-randr-output-names.t index e5049eb8..7c53732b 100644 --- a/testcases/t/196-randr-output-names.t +++ b/testcases/t/196-randr-output-names.t @@ -28,7 +28,7 @@ font -misc-fixed-medium-r-normal--13-120-75-75-C-70-iso10646-1 workspace 2 output DVI-I_1/digital EOT -my $output = qx(../i3 -C -c $filename); +my $output = qx(i3 -C -c $filename); unlike($output, qr/ERROR/, 'no errors in i3 -C'); close($fh); diff --git a/testcases/t/201-config-parser.t b/testcases/t/201-config-parser.t index d92d3b20..6cd84b6f 100644 --- a/testcases/t/201-config-parser.t +++ b/testcases/t/201-config-parser.t @@ -25,7 +25,7 @@ sub parser_calls { my ($command) = @_; my $stdout; - run [ '../test.config_parser', $command ], + run [ 'test.config_parser', $command ], '>/dev/null', '2>', \$stdout; # TODO: use a timeout, so that we can error out if it doesn’t terminate diff --git a/testcases/t/207-shmlog.t b/testcases/t/207-shmlog.t index b63a7499..b6c6d776 100644 --- a/testcases/t/207-shmlog.t +++ b/testcases/t/207-shmlog.t @@ -33,7 +33,7 @@ my $pid = launch_with_config($config); my $stdout; my $stderr; -run [ '../i3-dump-log/i3-dump-log' ], +run [ 'i3-dump-log' ], '>', \$stdout, '2>', \$stderr; @@ -49,7 +49,7 @@ cmd 'shmlog on'; my $random_nop = mktemp('nop.XXXXXX'); cmd "nop $random_nop"; -run [ '../i3-dump-log/i3-dump-log' ], +run [ 'i3-dump-log' ], '>', \$stdout, '2>', \$stderr; @@ -62,7 +62,7 @@ like($stderr, qr#^$#, 'stderr empty'); cmd 'shmlog ' . (23 * 1024 * 1024); -run [ '../i3-dump-log/i3-dump-log' ], +run [ 'i3-dump-log' ], '>', \$stdout, '2>', \$stderr; @@ -75,7 +75,7 @@ like($stderr, qr#^$#, 'stderr empty'); cmd 'shmlog off'; -run [ '../i3-dump-log/i3-dump-log' ], +run [ 'i3-dump-log' ], '>', \$stdout, '2>', \$stderr; diff --git a/testcases/t/235-check-config-no-x.t b/testcases/t/235-check-config-no-x.t index ec17353e..5e87d992 100644 --- a/testcases/t/235-check-config-no-x.t +++ b/testcases/t/235-check-config-no-x.t @@ -26,7 +26,7 @@ sub check_config { my ($config) = @_; my ($fh, $tmpfile) = tempfile(UNLINK => 1); print $fh $config; - my $output = qx(DISPLAY= ../i3 -C -c $tmpfile 2>&1); + my $output = qx(DISPLAY= i3 -C -c $tmpfile 2>&1); my $retval = $?; $fh->flush; close($fh);