From: Michael Stapelberg Date: Tue, 4 Oct 2011 22:39:36 +0000 (+0100) Subject: tests: move i3test.pm from t/lib to lib/ X-Git-Tag: 4.1~122^2 X-Git-Url: https://git.sur5r.net/?a=commitdiff_plain;h=bd33c09845d2069d11086f42d61efaba15d71f6d;p=i3%2Fi3 tests: move i3test.pm from t/lib to lib/ --- diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl index 322c23f2..70bcc8c1 100755 --- a/testcases/complete-run.pl +++ b/testcases/complete-run.pl @@ -188,7 +188,7 @@ sub take_job { my $output; my $parser = TAP::Parser->new({ - exec => [ 'sh', '-c', qq|DISPLAY=$display LOGPATH="$logpath" /usr/bin/perl -It/lib -Ilib $test| ], + exec => [ 'sh', '-c', qq|DISPLAY=$display LOGPATH="$logpath" /usr/bin/perl -Ilib $test| ], spool => IO::Scalar->new(\$output), merge => 1, }); diff --git a/testcases/lib/i3test.pm b/testcases/lib/i3test.pm new file mode 100644 index 00000000..cf29d7b9 --- /dev/null +++ b/testcases/lib/i3test.pm @@ -0,0 +1,450 @@ +package i3test; +# vim:ts=4:sw=4:expandtab + +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 EV; +use List::Util qw(first); +use List::MoreUtils qw(lastval); +use Time::HiRes qw(sleep); +use Try::Tiny; +use Cwd qw(abs_path); +use Proc::Background; +use SocketActivation; + +use v5.10; + +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 + does_i3_live + exit_gracefully + workspace_exists + focused_ws + get_socket_path + launch_with_config + wait_for_event + wait_for_map + wait_for_unmap +); + +my $tester = Test::Builder->new(); +my $_cached_socket_path = undef; +my $_sync_window = undef; +my $tmp_socket_path = undef; + +BEGIN { + my $window_count = 0; + sub counter_window { + return $window_count++; + } +} + +sub import { + my $class = shift; + my $pkg = caller; + eval "package $pkg; +use Test::Most" . (@_ > 0 ? " qw(@_)" : "") . "; +use Data::Dumper; +use AnyEvent::I3; +use Time::HiRes qw(sleep); +use Test::Deep qw(eq_deeply cmp_deeply cmp_set cmp_bag cmp_methods useclass noclass set bag subbagof superbagof subsetof supersetof superhashof subhashof bool str arraylength Isa ignore methods regexprefonly regexpmatches num regexponly scalref reftype hashkeysonly blessed array re hash regexpref hash_each shallow array_each code arrayelementsonly arraylengthonly scalarrefonly listmethods any hashkeys isa); +use v5.10; +use strict; +use warnings; +"; + @_ = ($class); + goto \&Exporter::import; +} + +# +# 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 $x, 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY }; +# +sub wait_for_event { + my ($x, $timeout, $cb) = @_; + + my $cv = AE::cv; + + my $prep = EV::prepare sub { + $x->flush; + }; + + my $check = EV::check sub { + while (defined(my $event = $x->poll_for_event)) { + if ($cb->($event)) { + $cv->send(1); + last; + } + } + }; + + my $watcher = EV::io $x->get_file_descriptor, EV::READ, sub { + # do nothing, we only need this watcher so that EV picks up the events + }; + + # 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; + return $result; +} + +# thin wrapper around wait_for_event which waits for MAP_NOTIFY +# make sure to include 'structure_notify' in the window’s event_mask attribute +sub wait_for_map { + my ($x) = @_; + wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY }; +} + +# Wrapper around wait_for_event which waits for UNMAP_NOTIFY. Also calls +# sync_with_i3 to make sure i3 also picked up and processed the UnmapNotify +# event. +sub wait_for_unmap { + my ($x) = @_; + wait_for_event $x, 2, sub { $_[0]->{response_type} == UNMAP_NOTIFY }; + sync_with_i3($x); +} + +# +# Opens a new window (see X11::XCB::Window), maps it, waits until it got mapped +# and synchronizes with i3. +# +# set dont_map to a true value to avoid mapping +# +# default values: +# class => WINDOW_CLASS_INPUT_OUTPUT +# rect => [ 0, 0, 30, 30 ] +# background_color => '#c0c0c0' +# event_mask => [ 'structure_notify' ] +# name => 'Window ' +# +sub open_window { + my ($x, $args) = @_; + my %args = ($args ? %$args : ()); + + my $dont_map = delete $args{dont_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); + + return $window if $dont_map; + + $window->map; + wait_for_map($x); + # We sync with i3 here to make sure $x->input_focus is updated. + sync_with_i3($x); + return $window; +} + +# Thin wrapper around open_window which sets window_type to +# _NET_WM_WINDOW_TYPE_UTILITY to make the window floating. +sub open_floating_window { + my ($x, $args) = @_; + my %args = ($args ? %$args : ()); + + $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY'); + + return open_window($x, \%args); +} + +sub open_empty_con { + my ($i3) = @_; + + my $reply = $i3->command('open')->recv; + return $reply->{id}; +} + +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) { + # get the first CT_CON of each output + my $content = first { $_->{type} == 2 } @{$output->{nodes}}; + @cons = (@cons, @{$content->{nodes}}); + } + [ map { $_->{name} } @cons ] +} + +sub get_unused_workspace { + my @names = get_workspace_names(); + my $tmp; + do { $tmp = tmpnam() } while ($tmp ~~ @names); + $tmp +} + +sub fresh_workspace { + my $unused = get_unused_workspace; + cmd("workspace $unused"); + $unused +} + +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} == 2 } @{$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; +} + +# +# 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 +# +sub get_ws_content { + my ($name) = @_; + my $con = get_ws($name); + return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes}; +} + +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}}; + @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}}); + $con = $cons[0]; + } + + return $lf; +} + +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} == 5 } + @{$output->{nodes}}); + } elsif ($which eq 'top') { + my $first = first { $_->{type} == 5 } @{$output->{nodes}}; + @docked = (@docked, @{$first->{nodes}}); + } elsif ($which eq 'bottom') { + my $last = lastval { $_->{type} == 5 } @{$output->{nodes}}; + @docked = (@docked, @{$last->{nodes}}); + } + } + return @docked; +} + +sub cmd { + i3(get_socket_path())->command(@_)->recv +} + +sub workspace_exists { + my ($name) = @_; + ($name ~~ @{get_workspace_names()}) +} + +sub focused_ws { + my $i3 = i3(get_socket_path()); + my $tree = $i3->get_tree->recv; + my @outputs = @{$tree->{nodes}}; + my @cons; + for my $output (@outputs) { + # get the first CT_CON of each output + my $content = first { $_->{type} == 2 } @{$output->{nodes}}; + my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}}; + return $first->{name} + } +} + +# +# 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 $x->input_focus returns the correct value afterwards. +# +# See also docs/testsuite for a long explanation +# +sub sync_with_i3 { + my ($x) = @_; + + # 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 (!defined($_sync_window)) { + $_sync_window = $x->root->create_child( + class => WINDOW_CLASS_INPUT_OUTPUT, + rect => X11::XCB::Rect->new(x => -15, y => -15, width => 10, height => 10 ), + override_redirect => 1, + background_color => '#ff0000', + event_mask => [ 'structure_notify' ], + ); + + $_sync_window->map; + + wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY }; + } + + 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, + + $_sync_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); + + # now wait until the reply is here + return wait_for_event $x, 2, sub { + my ($event) = @_; + # TODO: const + return 0 unless $event->{response_type} == 161; + + my ($win, $rnd) = unpack "LL", $event->{data}; + return ($rnd == $myrnd); + }; +} + +sub does_i3_live { + my $tree = i3(get_socket_path())->get_tree->recv; + my @nodes = @{$tree->{nodes}}; + my $ok = (@nodes > 0); + $tester->ok($ok, 'i3 still lives'); + return $ok; +} + +# Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails +sub exit_gracefully { + my ($pid, $socketpath) = @_; + $socketpath ||= get_socket_path(); + + my $exited = 0; + try { + say "Exiting i3 cleanly..."; + i3($socketpath)->command('exit')->recv; + $exited = 1; + }; + + if (!$exited) { + kill(9, $pid) or die "could not kill i3"; + } + + if ($socketpath =~ m,^/tmp/i3-test-socket-,) { + unlink($socketpath); + } +} + +# Gets the socket path from the I3_SOCKET_PATH atom stored on the X11 root window +sub get_socket_path { + my ($cache) = @_; + $cache ||= 1; + + if ($cache && defined($_cached_socket_path)) { + return $_cached_socket_path; + } + + my $x = X11::XCB::Connection->new; + 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}; + $_cached_socket_path = $socketpath; + return $socketpath; +} + +# +# launches a new i3 process with the given string as configuration file. +# useful for tests which test specific config file directives. +# +# be sure to use !NO_I3_INSTANCE! somewhere in the file to signal +# complete-run.pl that it should not create an instance of i3 +# +sub launch_with_config { + my ($config, $dont_add_socket_path) = @_; + + $dont_add_socket_path //= 0; + + if (!defined($tmp_socket_path)) { + $tmp_socket_path = File::Temp::tempnam('/tmp', 'i3-test-socket-'); + } + + my ($fh, $tmpfile) = tempfile('i3-test-config-XXXXX', UNLINK => 1); + say $fh $config; + say $fh "ipc-socket $tmp_socket_path" unless $dont_add_socket_path; + close($fh); + + my $cv = AnyEvent->condvar; + my $pid = activate_i3( + unix_socket_path => "$tmp_socket_path-activation", + display => $ENV{DISPLAY}, + configfile => $tmpfile, + logpath => $ENV{LOGPATH}, + cv => $cv, + ); + + # blockingly wait until i3 is ready + $cv->recv; + + # force update of the cached socket path in lib/i3test + get_socket_path(0); + + return $pid; +} + +1 diff --git a/testcases/t/lib/i3test.pm b/testcases/t/lib/i3test.pm deleted file mode 100644 index cf29d7b9..00000000 --- a/testcases/t/lib/i3test.pm +++ /dev/null @@ -1,450 +0,0 @@ -package i3test; -# vim:ts=4:sw=4:expandtab - -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 EV; -use List::Util qw(first); -use List::MoreUtils qw(lastval); -use Time::HiRes qw(sleep); -use Try::Tiny; -use Cwd qw(abs_path); -use Proc::Background; -use SocketActivation; - -use v5.10; - -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 - does_i3_live - exit_gracefully - workspace_exists - focused_ws - get_socket_path - launch_with_config - wait_for_event - wait_for_map - wait_for_unmap -); - -my $tester = Test::Builder->new(); -my $_cached_socket_path = undef; -my $_sync_window = undef; -my $tmp_socket_path = undef; - -BEGIN { - my $window_count = 0; - sub counter_window { - return $window_count++; - } -} - -sub import { - my $class = shift; - my $pkg = caller; - eval "package $pkg; -use Test::Most" . (@_ > 0 ? " qw(@_)" : "") . "; -use Data::Dumper; -use AnyEvent::I3; -use Time::HiRes qw(sleep); -use Test::Deep qw(eq_deeply cmp_deeply cmp_set cmp_bag cmp_methods useclass noclass set bag subbagof superbagof subsetof supersetof superhashof subhashof bool str arraylength Isa ignore methods regexprefonly regexpmatches num regexponly scalref reftype hashkeysonly blessed array re hash regexpref hash_each shallow array_each code arrayelementsonly arraylengthonly scalarrefonly listmethods any hashkeys isa); -use v5.10; -use strict; -use warnings; -"; - @_ = ($class); - goto \&Exporter::import; -} - -# -# 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 $x, 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY }; -# -sub wait_for_event { - my ($x, $timeout, $cb) = @_; - - my $cv = AE::cv; - - my $prep = EV::prepare sub { - $x->flush; - }; - - my $check = EV::check sub { - while (defined(my $event = $x->poll_for_event)) { - if ($cb->($event)) { - $cv->send(1); - last; - } - } - }; - - my $watcher = EV::io $x->get_file_descriptor, EV::READ, sub { - # do nothing, we only need this watcher so that EV picks up the events - }; - - # 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; - return $result; -} - -# thin wrapper around wait_for_event which waits for MAP_NOTIFY -# make sure to include 'structure_notify' in the window’s event_mask attribute -sub wait_for_map { - my ($x) = @_; - wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY }; -} - -# Wrapper around wait_for_event which waits for UNMAP_NOTIFY. Also calls -# sync_with_i3 to make sure i3 also picked up and processed the UnmapNotify -# event. -sub wait_for_unmap { - my ($x) = @_; - wait_for_event $x, 2, sub { $_[0]->{response_type} == UNMAP_NOTIFY }; - sync_with_i3($x); -} - -# -# Opens a new window (see X11::XCB::Window), maps it, waits until it got mapped -# and synchronizes with i3. -# -# set dont_map to a true value to avoid mapping -# -# default values: -# class => WINDOW_CLASS_INPUT_OUTPUT -# rect => [ 0, 0, 30, 30 ] -# background_color => '#c0c0c0' -# event_mask => [ 'structure_notify' ] -# name => 'Window ' -# -sub open_window { - my ($x, $args) = @_; - my %args = ($args ? %$args : ()); - - my $dont_map = delete $args{dont_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); - - return $window if $dont_map; - - $window->map; - wait_for_map($x); - # We sync with i3 here to make sure $x->input_focus is updated. - sync_with_i3($x); - return $window; -} - -# Thin wrapper around open_window which sets window_type to -# _NET_WM_WINDOW_TYPE_UTILITY to make the window floating. -sub open_floating_window { - my ($x, $args) = @_; - my %args = ($args ? %$args : ()); - - $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY'); - - return open_window($x, \%args); -} - -sub open_empty_con { - my ($i3) = @_; - - my $reply = $i3->command('open')->recv; - return $reply->{id}; -} - -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) { - # get the first CT_CON of each output - my $content = first { $_->{type} == 2 } @{$output->{nodes}}; - @cons = (@cons, @{$content->{nodes}}); - } - [ map { $_->{name} } @cons ] -} - -sub get_unused_workspace { - my @names = get_workspace_names(); - my $tmp; - do { $tmp = tmpnam() } while ($tmp ~~ @names); - $tmp -} - -sub fresh_workspace { - my $unused = get_unused_workspace; - cmd("workspace $unused"); - $unused -} - -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} == 2 } @{$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; -} - -# -# 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 -# -sub get_ws_content { - my ($name) = @_; - my $con = get_ws($name); - return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes}; -} - -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}}; - @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}}); - $con = $cons[0]; - } - - return $lf; -} - -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} == 5 } - @{$output->{nodes}}); - } elsif ($which eq 'top') { - my $first = first { $_->{type} == 5 } @{$output->{nodes}}; - @docked = (@docked, @{$first->{nodes}}); - } elsif ($which eq 'bottom') { - my $last = lastval { $_->{type} == 5 } @{$output->{nodes}}; - @docked = (@docked, @{$last->{nodes}}); - } - } - return @docked; -} - -sub cmd { - i3(get_socket_path())->command(@_)->recv -} - -sub workspace_exists { - my ($name) = @_; - ($name ~~ @{get_workspace_names()}) -} - -sub focused_ws { - my $i3 = i3(get_socket_path()); - my $tree = $i3->get_tree->recv; - my @outputs = @{$tree->{nodes}}; - my @cons; - for my $output (@outputs) { - # get the first CT_CON of each output - my $content = first { $_->{type} == 2 } @{$output->{nodes}}; - my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}}; - return $first->{name} - } -} - -# -# 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 $x->input_focus returns the correct value afterwards. -# -# See also docs/testsuite for a long explanation -# -sub sync_with_i3 { - my ($x) = @_; - - # 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 (!defined($_sync_window)) { - $_sync_window = $x->root->create_child( - class => WINDOW_CLASS_INPUT_OUTPUT, - rect => X11::XCB::Rect->new(x => -15, y => -15, width => 10, height => 10 ), - override_redirect => 1, - background_color => '#ff0000', - event_mask => [ 'structure_notify' ], - ); - - $_sync_window->map; - - wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY }; - } - - 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, - - $_sync_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); - - # now wait until the reply is here - return wait_for_event $x, 2, sub { - my ($event) = @_; - # TODO: const - return 0 unless $event->{response_type} == 161; - - my ($win, $rnd) = unpack "LL", $event->{data}; - return ($rnd == $myrnd); - }; -} - -sub does_i3_live { - my $tree = i3(get_socket_path())->get_tree->recv; - my @nodes = @{$tree->{nodes}}; - my $ok = (@nodes > 0); - $tester->ok($ok, 'i3 still lives'); - return $ok; -} - -# Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails -sub exit_gracefully { - my ($pid, $socketpath) = @_; - $socketpath ||= get_socket_path(); - - my $exited = 0; - try { - say "Exiting i3 cleanly..."; - i3($socketpath)->command('exit')->recv; - $exited = 1; - }; - - if (!$exited) { - kill(9, $pid) or die "could not kill i3"; - } - - if ($socketpath =~ m,^/tmp/i3-test-socket-,) { - unlink($socketpath); - } -} - -# Gets the socket path from the I3_SOCKET_PATH atom stored on the X11 root window -sub get_socket_path { - my ($cache) = @_; - $cache ||= 1; - - if ($cache && defined($_cached_socket_path)) { - return $_cached_socket_path; - } - - my $x = X11::XCB::Connection->new; - 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}; - $_cached_socket_path = $socketpath; - return $socketpath; -} - -# -# launches a new i3 process with the given string as configuration file. -# useful for tests which test specific config file directives. -# -# be sure to use !NO_I3_INSTANCE! somewhere in the file to signal -# complete-run.pl that it should not create an instance of i3 -# -sub launch_with_config { - my ($config, $dont_add_socket_path) = @_; - - $dont_add_socket_path //= 0; - - if (!defined($tmp_socket_path)) { - $tmp_socket_path = File::Temp::tempnam('/tmp', 'i3-test-socket-'); - } - - my ($fh, $tmpfile) = tempfile('i3-test-config-XXXXX', UNLINK => 1); - say $fh $config; - say $fh "ipc-socket $tmp_socket_path" unless $dont_add_socket_path; - close($fh); - - my $cv = AnyEvent->condvar; - my $pid = activate_i3( - unix_socket_path => "$tmp_socket_path-activation", - display => $ENV{DISPLAY}, - configfile => $tmpfile, - logpath => $ENV{LOGPATH}, - cv => $cv, - ); - - # blockingly wait until i3 is ready - $cv->recv; - - # force update of the cached socket path in lib/i3test - get_socket_path(0); - - return $pid; -} - -1