use List::Util qw(first);
use Time::HiRes qw(sleep);
use Cwd qw(abs_path);
+use POSIX ':sys_wait_h';
use Scalar::Util qw(blessed);
use SocketActivation;
use i3test::Util qw(slurp);
use Exporter ();
our @EXPORT = qw(
get_workspace_names
+ get_output_for_workspace
get_unused_workspace
fresh_workspace
get_ws_content
cmd
sync_with_i3
exit_gracefully
+ exit_forcefully
workspace_exists
focused_ws
get_socket_path
wait_for_unmap
$x
kill_all_windows
+ events_for
+ listen_for_binding
+ is_net_wm_state_focused
+ cmp_tree
);
=head1 NAME
C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
to you in your testcase.
-See also C<i3test::Test> (L<http://build.i3wm.org/docs/lib-i3test-test.html>)
+See also C<i3test::Test> (L<https://build.i3wm.org/docs/lib-i3test-test.html>)
which provides additional test instructions (like C<ok> or C<is>).
=cut
} else {
kill(-9, $i3_pid)
- or $tester->BAIL_OUT("could not kill i3");
+ or $tester->BAIL_OUT("could not kill i3: $!");
waitpid $i3_pid, 0;
}
my ($class, %args) = @_;
my $pkg = caller;
+ $x ||= i3test::X11->new;
+ # set the pointer to a predictable position in case a previous test has
+ # disturbed it
+ $x->warp_pointer(
+ 0, # src_window (None)
+ $x->get_root_window(), # dst_window (None)
+ 0, # src_x
+ 0, # src_y
+ 0, # src_width
+ 0, # src_height
+ 0, # dst_x
+ 0); # dst_y
+ # Synchronize with X11 to ensure the pointer has been warped before i3
+ # starts up.
+ $x->get_input_focus_reply($x->get_input_focus()->{sequence});
+
$i3_autostart = delete($args{i3_autostart}) // 1;
my $i3_config = delete($args{i3_config}) // '-default';
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);
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;
+ while (defined(my $event = $x->wait_for_event)) {
+ return 1 if $cb->($event);
+ }
}
=head2 wait_for_map($window)
$window->map;
wait_for_map($window);
+
+ # MapWindow is sent before i3 even starts rendering: the window is placed at
+ # temporary off-screen coordinates first, and x_push_changes() sends further
+ # X11 requests to set focus etc. Hence, we sync with i3 before continuing.
+ sync_with_i3();
+
return $window;
}
[ map { $_->{name} } @cons ]
}
+=head2 get_output_for_workspace()
+
+Returns the name of the output on which this workspace resides
+
+ cmd 'focus output fake-1';
+ cmd 'workspace 1';
+ is(get_output_for_workspace('1', 'fake-0', 'Workspace 1 in output fake-0');
+
+=cut
+sub get_output_for_workspace {
+ my $ws_name = shift @_;
+ my $i3 = i3(get_socket_path());
+ my $tree = $i3->get_tree->recv;
+ my @outputs = @{$tree->{nodes}};
+
+ foreach (grep { not $_->{name} =~ /^__/ } @outputs) {
+ my $output = $_->{name};
+ foreach (grep { $_->{name} =~ "content" } @{$_->{nodes}}) {
+ return $output if $_->{nodes}[0]->{name} =~ $ws_name;
+ }
+ }
+}
+
=head2 get_unused_workspace
Returns a workspace name which has not yet been used. See also
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<http://build.i3wm.org/docs/testsuite.html> for a longer explanation.
+See also L<https://build.i3wm.org/docs/testsuite.html> for a longer explanation.
my $window = open_window;
$window->add_hint('urgency');
$_sync_window = open_window(
rect => [ -15, -15, 10, 10 ],
override_redirect => 1,
+ dont_map => 1,
);
}
if (!$exited) {
kill(9, $pid)
- or $tester->BAIL_OUT("could not kill i3");
+ or $tester->BAIL_OUT("could not kill i3: $!");
}
if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
undef $i3_pid;
}
+=head2 exit_forcefully($pid, [ $signal ])
+
+Tries to exit i3 forcefully by sending a signal (defaults to SIGTERM).
+
+You only need to use this function if you want to test signal handling
+(in which case you must have launched i3 on your own with
+C<launch_with_config>).
+
+ use i3test i3_autostart => 0;
+ my $pid = launch_with_config($config);
+ # …
+ exit_forcefully($pid);
+
+=cut
+sub exit_forcefully {
+ my ($pid, $signal) = @_;
+ $signal ||= 'TERM';
+
+ # Send the given signal to the i3 instance and wait for up to 10s
+ # for it to terminate.
+ kill($signal, $pid)
+ or $tester->BAIL_OUT("could not kill i3: $!");
+ my $status;
+ my $timeout = 10;
+ do {
+ $status = waitpid $pid, WNOHANG;
+
+ if ($status <= 0) {
+ sleep(1);
+ $timeout--;
+ }
+ } while ($status <= 0 && $timeout > 0);
+
+ if ($status <= 0) {
+ kill('KILL', $pid)
+ or $tester->BAIL_OUT("could not kill i3: $!");
+ waitpid $pid, 0;
+ }
+ undef $i3_pid;
+}
+
=head2 get_socket_path([ $cache ])
Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
cmd '[title=".*"] kill';
}
+=head2 events_for($subscribecb, [ $rettype ], [ $eventcbs ])
+
+Helper function which returns an array containing all events of type $rettype
+which were generated by i3 while $subscribecb was running.
+
+Set $eventcbs to subscribe to multiple event types and/or perform your own event
+aggregation.
+
+=cut
+sub events_for {
+ my ($subscribecb, $rettype, $eventcbs) = @_;
+
+ my @events;
+ $eventcbs //= {};
+ if (defined($rettype)) {
+ $eventcbs->{$rettype} = sub { push @events, shift };
+ }
+ my $subscribed = AnyEvent->condvar;
+ my $flushed = AnyEvent->condvar;
+ $eventcbs->{tick} = sub {
+ my ($event) = @_;
+ if ($event->{first}) {
+ $subscribed->send($event);
+ } else {
+ $flushed->send($event);
+ }
+ };
+ my $i3 = i3(get_socket_path(0));
+ $i3->connect->recv;
+ $i3->subscribe($eventcbs)->recv;
+ $subscribed->recv;
+ # Subscription established, run the callback.
+ $subscribecb->();
+ # Now generate a tick event, which we know we’ll receive (and at which point
+ # all other events have been received).
+ my $nonce = int(rand(255)) + 1;
+ $i3->send_tick($nonce);
+
+ my $tick = $flushed->recv;
+ $tester->is_eq($tick->{payload}, $nonce, 'tick nonce received');
+ return @events;
+}
+
+=head2 listen_for_binding($cb)
+
+Helper function to evaluate whether sending KeyPress/KeyRelease events via XTEST
+triggers an i3 key binding or not. Expects key bindings to be configured in the
+form “bindsym <binding> nop <binding>”, e.g. “bindsym Mod4+Return nop
+Mod4+Return”.
+
+ is(listen_for_binding(
+ sub {
+ xtest_key_press(133); # Super_L
+ xtest_key_press(36); # Return
+ xtest_key_release(36); # Return
+ xtest_key_release(133); # Super_L
+ xtest_sync_with_i3;
+ },
+ ),
+ 'Mod4+Return',
+ 'triggered the "Mod4+Return" keybinding');
+
+=cut
+
+sub listen_for_binding {
+ my ($cb) = @_;
+ my $triggered = AnyEvent->condvar;
+ my @events = events_for(
+ $cb,
+ 'binding');
+
+ $tester->is_eq(scalar @events, 1, 'Received precisely one event');
+ $tester->is_eq($events[0]->{change}, 'run', 'change is "run"');
+ # We look at the command (which is “nop <binding>”) because that is easier
+ # than re-assembling the string representation of $event->{binding}.
+ my $command = $events[0]->{binding}->{command};
+ $command =~ s/^nop //g;
+ return $command;
+}
+
+=head2 is_net_wm_state_focused
+
+Returns true if the given window has the _NET_WM_STATE_FOCUSED atom.
+
+ ok(is_net_wm_state_focused($window), '_NET_WM_STATE_FOCUSED set');
+
+=cut
+sub is_net_wm_state_focused {
+ my ($window) = @_;
+
+ sync_with_i3;
+ my $atom = $x->atom(name => '_NET_WM_STATE_FOCUSED');
+ my $cookie = $x->get_property(
+ 0,
+ $window->{id},
+ $x->atom(name => '_NET_WM_STATE')->id,
+ GET_PROPERTY_TYPE_ANY,
+ 0,
+ 4096
+ );
+
+ my $reply = $x->get_property_reply($cookie->{sequence});
+ my $len = $reply->{length};
+ return 0 if $len == 0;
+
+ my @atoms = unpack("L$len", $reply->{value});
+ for (my $i = 0; $i < $len; $i++) {
+ return 1 if $atoms[$i] == $atom->id;
+ }
+
+ return 0;
+}
+
+=head2 cmp_tree([ $args ])
+
+Compares the tree layout before and after an operation inside a subtest.
+
+The following arguments can be passed:
+
+=over 4
+
+=item layout_before
+
+Required argument. The initial layout to be created. For example,
+'H[ V[ a* S[ b c ] d ] e ]' or 'V[a b] T[c d*]'.
+The layout will be converted to a JSON file which will be passed to i3's
+append_layout command.
+
+The syntax's rules, assertions and limitations are:
+
+=over 8
+
+=item 1.
+
+Upper case letters H, V, S, T mean horizontal, vertical, stacked and tabbed
+layout respectively. They must be followed by an opening square bracket and must
+be closed with a closing square bracket.
+Each of the non-leaf containers is marked with their corresponding letter
+followed by a number indicating the position of the container relative to other
+containers of the same type. For example, 'H[V[xxx] V[xxx] H[xxx]]' will mark
+the non-leaf containers as H1, V1, V2, H2.
+
+=item 2.
+
+Spaces are ignored.
+
+=item 3.
+
+Other alphanumeric characters mean a new window which uses the provided
+character for its class and name. Eg 'H[a b]' will open windows with classes 'a'
+and 'b' inside a horizontal split. Windows use a single character for their
+class, eg 'H[xxx]' will open 3 windows with class 'x'.
+
+=item 4.
+
+Asterisks after a window mean that the window must be focused after the layout
+is loaded. Currently, focusing non-leaf containers must be done manually, in the
+callback (C<cb>) function.
+
+=back
+
+=item cb
+
+Subroutine to be called after the layout provided by C<layout_before> is created
+but before the resulting layout (C<layout_after>) is checked.
+
+=item layout_after
+
+Required argument. The final layout in which the tree is expected to be after
+the callback is called. Uses the same syntax with C<layout_before>.
+For non-leaf containers, their layout (horizontal, vertical, stacked, tabbed)
+is compared with the corresponding letter (H, V, S, T).
+For leaf containers, their name is compared with the provided alphanumeric.
+
+=item ws
+
+The workspace in which the layout will be created. Will switch focus to it. If
+not provided, a new one is created.
+
+=item msg
+
+Message to prepend to the subtest's name. If not empty, it will be followed by ': '.
+
+=item dont_kill
+
+By default, all windows are killed before the C<layout_before> layout is loaded.
+Set to 1 to avoid this.
+
+=back
+
+=cut
+sub cmp_tree {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ my %args = @_;
+ my $ws = $args{ws};
+ if (defined($ws)) {
+ cmd "workspace $ws";
+ } else {
+ $ws = fresh_workspace;
+ }
+ my $msg = '';
+ if ($args{msg}) {
+ $msg = $args{msg} . ': ';
+ }
+ die unless $args{layout_before};
+ die unless $args{layout_after};
+
+ kill_all_windows unless $args{dont_kill};
+ my @windows = create_layout($args{layout_before});
+ Test::More::subtest $msg . $args{layout_before} . ' -> ' . $args{layout_after} => sub {
+ $args{cb}->(\@windows) if $args{cb};
+ verify_layout($args{layout_after}, $ws);
+ };
+
+ return @windows;
+}
+
+sub create_layout {
+ my $layout = shift;
+
+ my $focus;
+ my @windows = ();
+ my $r = '';
+ my $depth = 0;
+ my %layout_counts = (H => 0, V => 0, S => 0, T => 0);
+
+ foreach my $char (split('', $layout)) {
+ if ($char eq 'H') {
+ $r = $r . '{"layout": "splith",';
+ $r = $r . '"marks": ["H' . ++$layout_counts{H} . '"],';
+ } elsif ($char eq 'V') {
+ $r = $r . '{"layout": "splitv",';
+ $r = $r . '"marks": ["V' . ++$layout_counts{V} . '"],';
+ } elsif ($char eq 'S') {
+ $r = $r . '{"layout": "stacked",';
+ $r = $r . '"marks": ["S' . ++$layout_counts{S} . '"],';
+ } elsif ($char eq 'T') {
+ $r = $r . '{"layout": "tabbed",';
+ $r = $r . '"marks": ["T' . ++$layout_counts{T} . '"],';
+ } elsif ($char eq '[') {
+ $depth++;
+ $r = $r . '"nodes": [';
+ } elsif ($char eq ']') {
+ # End of nodes array: delete trailing comma.
+ chop $r;
+ # When we are at depth 0 we need to split using newlines, making
+ # multiple "JSON texts".
+ $depth--;
+ $r = $r . ']}' . ($depth == 0 ? "\n" : ',');
+ } elsif ($char eq ' ') {
+ } elsif ($char eq '*') {
+ $focus = $windows[$#windows];
+ } elsif ($char =~ /[[:alnum:]]/) {
+ push @windows, $char;
+
+ $r = $r . '{"swallows": [{';
+ $r = $r . '"class": "^' . "$char" . '$"';
+ $r = $r . '}]},';
+ } else {
+ die "Could not understand $char";
+ }
+ }
+
+ die "Invalid layout, depth is $depth > 0" unless $depth == 0;
+
+ Test::More::diag($r);
+ my ($fh, $tmpfile) = tempfile("layout-XXXXXX", UNLINK => 1);
+ print $fh "$r\n";
+ close($fh);
+
+ my $return = cmd "append_layout $tmpfile";
+ die 'Could not parse layout json file' unless $return->[0]->{success};
+
+ my @result_windows;
+ push @result_windows, open_window(wm_class => "$_", name => "$_") foreach @windows;
+ cmd '[class=' . $focus . '] focus' if $focus;
+
+ return @result_windows;
+}
+
+sub verify_layout {
+ my ($layout, $ws) = @_;
+
+ my $nodes = get_ws_content($ws);
+ my %counters;
+ my $depth = 0;
+ my $node;
+
+ foreach my $char (split('', $layout)) {
+ my $node_name;
+ my $node_layout;
+ if ($char eq 'H') {
+ $node_layout = 'splith';
+ } elsif ($char eq 'V') {
+ $node_layout = 'splitv';
+ } elsif ($char eq 'S') {
+ $node_layout = 'stacked';
+ } elsif ($char eq 'T') {
+ $node_layout = 'tabbed';
+ } elsif ($char eq '[') {
+ $depth++;
+ delete $counters{$depth};
+ } elsif ($char eq ']') {
+ $depth--;
+ } elsif ($char eq ' ') {
+ } elsif ($char eq '*') {
+ $tester->is_eq($node->{focused}, 1, 'Correct node focused');
+ } elsif ($char =~ /[[:alnum:]]/) {
+ $node_name = $char;
+ } else {
+ die "Could not understand $char";
+ }
+
+ if ($node_layout || $node_name) {
+ if (exists($counters{$depth})) {
+ $counters{$depth} = $counters{$depth} + 1;
+ } else {
+ $counters{$depth} = 0;
+ }
+
+ $node = $nodes->[$counters{0}];
+ for my $i (1 .. $depth) {
+ $node = $node->{nodes}->[$counters{$i}];
+ }
+
+ if ($node_layout) {
+ $tester->is_eq($node->{layout}, $node_layout, "Layouts match in depth $depth, node number " . $counters{$depth});
+ } else {
+ $tester->is_eq($node->{name}, $node_name, "Names match in depth $depth, node number " . $counters{$depth});
+ }
+ }
+ }
+}
+
+
+
=head1 AUTHOR
Michael Stapelberg <michael@i3wm.org>