2 # vim:ts=4:sw=4:expandtab
3 use strict; use warnings;
5 use File::Temp qw(tmpnam tempfile tempdir);
11 use List::Util qw(first);
12 use Time::HiRes qw(sleep);
14 use Scalar::Util qw(blessed);
50 i3test - Testcase setup module
58 my $ws = fresh_workspace;
59 is_num_children($ws, 0, 'no containers on this workspace yet');
61 is_num_children($ws, 1, 'one container after "open"');
67 This module is used in every i3 testcase and takes care of automatically
68 starting i3 before any test instructions run. It also saves you typing of lots
69 of boilerplate in every test file.
72 i3test automatically "use"s C<Test::More>, C<Data::Dumper>, C<AnyEvent::I3>,
73 C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
74 to you in your testcase.
76 See also C<i3test::Test> (L<http://build.i3wm.org/docs/lib-i3test-test.html>)
77 which provides additional test instructions (like C<ok> or C<is>).
81 my $tester = Test::Builder->new();
82 my $_cached_socket_path = undef;
83 my $_sync_window = undef;
84 my $tmp_socket_path = undef;
91 return $window_count++;
100 # testcases which start i3 manually should always call exit_gracefully
101 # on their own. Let’s see, whether they really did.
102 if (! $i3_autostart) {
103 return unless $i3_pid;
105 $tester->ok(undef, 'testcase called exit_gracefully()');
108 # don't trigger SIGCHLD handler
111 # From perldoc -v '$?':
112 # Inside an "END" subroutine $? contains the value
113 # that is going to be given to "exit()".
115 # Since waitpid sets $?, we need to localize it,
116 # otherwise TAP would be misinterpreted our return status
119 # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
120 # files are not written)
121 if ($ENV{COVERAGE} || $ENV{VALGRIND}) {
122 exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}");
126 or $tester->BAIL_OUT("could not kill i3");
133 my ($class, %args) = @_;
136 $i3_autostart = delete($args{i3_autostart}) // 1;
138 my $cv = launch_with_config('-default', dont_block => 1)
141 my $test_more_args = '';
142 $test_more_args = join(' ', 'qw(', %args, ')') if keys %args;
146 use Test::More $test_more_args;
149 use Time::HiRes qw(sleep);
152 $tester->BAIL_OUT("$@") if $@;
153 feature->import(":5.10");
157 $x ||= i3test::X11->new;
158 $cv->recv if $i3_autostart;
161 goto \&Exporter::import;
166 =head2 wait_for_event($timeout, $callback)
168 Waits for the next event and calls the given callback for every event to
169 determine if this is the event we are waiting for.
171 Can be used to wait until a window is mapped, until a ClientMessage is
174 wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
178 my ($timeout, $cb) = @_;
184 # unfortunately, there is no constant for this
187 my $guard = AE::io $x->get_file_descriptor, $ae_read, sub {
188 while (defined(my $event = $x->poll_for_event)) {
196 # Trigger timeout after $timeout seconds (can be fractional)
197 my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) };
199 my $result = $cv->recv;
205 =head2 wait_for_map($window)
207 Thin wrapper around wait_for_event which waits for MAP_NOTIFY.
208 Make sure to include 'structure_notify' in the window’s event_mask attribute.
210 This function is called by C<open_window>, so in most cases, you don’t need to
211 call it on your own. If you need special setup of the window before mapping,
212 you might have to map it on your own and use this function:
214 my $window = open_window(dont_map => 1);
215 # Do something special with the window first
218 # Now map it and wait until it’s been mapped
220 wait_for_map($window);
225 my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
226 wait_for_event 2, sub {
227 $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id
231 =head2 wait_for_unmap($window)
233 Wrapper around C<wait_for_event> which waits for UNMAP_NOTIFY. Also calls
234 C<sync_with_i3> to make sure i3 also picked up and processed the UnmapNotify
237 my $ws = fresh_workspace;
238 my $window = open_window;
239 is_num_children($ws, 1, 'one window on workspace');
242 is_num_children($ws, 0, 'no more windows on this workspace');
247 # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
248 wait_for_event 2, sub {
249 $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id
254 =head2 open_window([ $args ])
256 Opens a new window (see C<X11::XCB::Window>), maps it, waits until it got mapped
257 and synchronizes with i3.
259 The following arguments can be passed:
265 The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with
270 An arrayref with 4 members specifying the initial geometry (position and size)
271 of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100
272 with width=70 and height=50.
274 Note that this is entirely irrelevant for tiling windows.
276 =item background_color
278 The background pixel color of the window, formatted as "#rrggbb", like HTML
279 color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually
280 watching the testcases.
284 An arrayref containing strings which describe the X11 event mask we use for that
285 window. The default is C<< [ 'structure_notify' ] >>.
289 The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window
290 n" with n being replaced by a counter to keep windows apart.
294 Set to a true value to avoid mapping the window (making it visible).
298 A coderef which is called before the window is mapped (unless C<dont_map> is
299 true). The freshly created C<$window> is passed as C<$_> and as the first
304 The default values are equivalent to this call:
307 class => WINDOW_CLASS_INPUT_OUTPUT
308 rect => [ 0, 0, 30, 30 ]
309 background_color => '#c0c0c0'
310 event_mask => [ 'structure_notify' ]
314 Usually, though, calls are simpler:
316 my $top_window = open_window;
318 To identify the resulting window object in i3 commands, use the id property:
320 my $top_window = open_window;
321 cmd '[id="' . $top_window->id . '"] kill';
325 my %args = @_ == 1 ? %{$_[0]} : @_;
327 my $dont_map = delete $args{dont_map};
328 my $before_map = delete $args{before_map};
330 $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
331 $args{rect} //= [ 0, 0, 30, 30 ];
332 $args{background_color} //= '#c0c0c0';
333 $args{event_mask} //= [ 'structure_notify' ];
334 $args{name} //= 'Window ' . counter_window();
336 my $window = $x->root->create_child(%args);
339 # TODO: investigate why _create is not needed
341 $before_map->($window) for $window;
344 return $window if $dont_map;
347 wait_for_map($window);
351 =head2 open_floating_window([ $args ])
353 Thin wrapper around open_window which sets window_type to
354 C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating.
356 The arguments are the same as those of C<open_window>.
359 sub open_floating_window {
360 my %args = @_ == 1 ? %{$_[0]} : @_;
362 $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY');
364 return open_window(\%args);
370 my $reply = $i3->command('open')->recv;
371 return $reply->[0]->{id};
374 =head2 get_workspace_names()
376 Returns an arrayref containing the name of every workspace (regardless of its
377 output) which currently exists.
379 my $workspace_names = get_workspace_names;
380 is(scalar @$workspace_names, 3, 'three workspaces exist currently');
383 sub get_workspace_names {
384 my $i3 = i3(get_socket_path());
385 my $tree = $i3->get_tree->recv;
386 my @outputs = @{$tree->{nodes}};
388 for my $output (@outputs) {
389 next if $output->{name} eq '__i3';
390 # get the first CT_CON of each output
391 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
392 @cons = (@cons, @{$content->{nodes}});
394 [ map { $_->{name} } @cons ]
397 =head2 get_unused_workspace
399 Returns a workspace name which has not yet been used. See also
400 C<fresh_workspace> which directly switches to an unused workspace.
402 my $ws = get_unused_workspace;
406 sub get_unused_workspace {
407 my @names = get_workspace_names();
409 do { $tmp = tmpnam() } while ($tmp ~~ @names);
413 =head2 fresh_workspace([ $args ])
415 Switches to an unused workspace and returns the name of that workspace.
417 Optionally switches to the specified output first.
419 my $ws = fresh_workspace;
421 # Get a fresh workspace on the second output.
422 my $ws = fresh_workspace(output => 1);
425 sub fresh_workspace {
427 if (exists($args{output})) {
428 my $i3 = i3(get_socket_path());
429 my $tree = $i3->get_tree->recv;
430 my $output = first { $_->{name} eq "fake-$args{output}" }
432 die "BUG: Could not find output $args{output}" unless defined($output);
433 # Get the focused workspace on that output and switch to it.
434 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
435 my $focused = $content->{focus}->[0];
436 my $workspace = first { $_->{id} == $focused } @{$content->{nodes}};
437 $workspace = $workspace->{name};
438 cmd("workspace $workspace");
441 my $unused = get_unused_workspace;
442 cmd("workspace $unused");
446 =head2 get_ws($workspace)
448 Returns the container (from the i3 layout tree) which represents C<$workspace>.
450 my $ws = fresh_workspace;
451 my $ws_con = get_ws($ws);
452 ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent');
454 Here is an example which counts the number of urgent containers recursively,
455 starting from the workspace container:
460 my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}});
461 my $urgent = grep { $_->{urgent} } @children;
462 $urgent += count_urgent($_) for @children;
465 my $urgent = count_urgent(get_ws($ws));
466 is($urgent, 3, "three urgent windows on workspace $ws");
472 my $i3 = i3(get_socket_path());
473 my $tree = $i3->get_tree->recv;
475 my @outputs = @{$tree->{nodes}};
477 for my $output (@outputs) {
478 # get the first CT_CON of each output
479 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
480 @workspaces = (@workspaces, @{$content->{nodes}});
483 # as there can only be one workspace with this name, we can safely
484 # return the first entry
485 return first { $_->{name} eq $name } @workspaces;
488 =head2 get_ws_content($workspace)
490 Returns the content (== tree, starting from the node of a workspace)
491 of a workspace. If called in array context, also includes the focus
492 stack of the workspace.
494 my $nodes = get_ws_content($ws);
495 is(scalar @$nodes, 4, 'there are four containers at workspace-level');
497 Or, in array context:
499 my $window = open_window;
500 my ($nodes, $focus) = get_ws_content($ws);
501 is($focus->[0], $window->id, 'newly opened window focused');
503 Note that this function does not do recursion for you! It only returns the
504 containers B<on workspace level>. If you want to work with all containers (even
505 nested ones) on a workspace, you have to use recursion:
507 # NB: This function does not count floating windows
512 for my $con (@$nodes) {
513 $urgent++ if $con->{urgent};
514 $urgent += count_urgent($con->{nodes});
519 my $nodes = get_ws_content($ws);
520 my $urgent = count_urgent($nodes);
521 is($urgent, 3, "three urgent windows on workspace $ws");
523 If you also want to deal with floating windows, you have to use C<get_ws>
524 instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own.
529 my $con = get_ws($name);
530 return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes};
533 =head2 get_focused($workspace)
535 Returns the container ID of the currently focused container on C<$workspace>.
537 Note that the container ID is B<not> the X11 window ID, so comparing the result
538 of C<get_focused> with a window's C<< ->{id} >> property does B<not> work.
540 my $ws = fresh_workspace;
541 my $first_window = open_window;
542 my $first_id = get_focused();
544 my $second_window = open_window;
545 my $second_id = get_focused();
549 is(get_focused($ws), $first_id, 'second window focused');
554 my $con = get_ws($ws);
556 my @focused = @{$con->{focus}};
558 while (@focused > 0) {
560 last unless defined($con->{focus});
561 @focused = @{$con->{focus}};
562 my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
569 =head2 get_dock_clients([ $dockarea ])
571 Returns an array of all dock containers in C<$dockarea> (one of "top" or
572 "bottom"). If C<$dockarea> is not specified, returns an array of all dock
573 containers in any dockarea.
575 my @docked = get_dock_clients;
576 is(scalar @docked, 0, 'no dock clients yet');
579 sub get_dock_clients {
582 my $tree = i3(get_socket_path())->get_tree->recv;
583 my @outputs = @{$tree->{nodes}};
584 # Children of all dockareas
586 for my $output (@outputs) {
587 if (!defined($which)) {
588 @docked = (@docked, map { @{$_->{nodes}} }
589 grep { $_->{type} == 5 }
590 @{$output->{nodes}});
591 } elsif ($which eq 'top') {
592 my $first = first { $_->{type} == 5 } @{$output->{nodes}};
593 @docked = (@docked, @{$first->{nodes}}) if defined($first);
594 } elsif ($which eq 'bottom') {
595 my @matching = grep { $_->{type} == 5 } @{$output->{nodes}};
596 my $last = $matching[-1];
597 @docked = (@docked, @{$last->{nodes}}) if defined($last);
605 Sends the specified command to i3.
607 my $ws = unused_workspace;
613 i3(get_socket_path())->command(@_)->recv
616 =head2 workspace_exists($workspace)
618 Returns true if C<$workspace> is the name of an existing workspace.
620 my $old_ws = focused_ws;
621 # switch away from where we currently are
624 ok(workspace_exists($old_ws), 'old workspace still exists');
627 sub workspace_exists {
629 ($name ~~ @{get_workspace_names()})
634 Returns the name of the currently focused workspace.
637 is($ws, '1', 'i3 starts on workspace 1');
641 my $i3 = i3(get_socket_path());
642 my $tree = $i3->get_tree->recv;
643 my $focused = $tree->{focus}->[0];
644 my $output = first { $_->{id} == $focused } @{$tree->{nodes}};
645 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
646 my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}};
647 return $first->{name}
650 =head2 sync_with_i3([ $args ])
652 Sends an I3_SYNC ClientMessage with a random value to the root window.
653 i3 will reply with the same value, but, due to the order of events it
654 processes, only after all other events are done.
656 This can be used to ensure the results of a cmd 'focus left' are pushed to
657 X11 and that C<< $x->input_focus >> returns the correct value afterwards.
659 See also L<http://build.i3wm.org/docs/testsuite.html> for a longer explanation.
661 my $window = open_window;
662 $window->add_hint('urgency');
663 # Ensure i3 picked up the change
666 The only time when you need to use the C<no_cache> argument is when you just
667 killed your own X11 connection:
670 # We need to re-establish the X11 connection which we just killed :).
671 $x = i3test::X11->new;
672 sync_with_i3(no_cache => 1);
676 my %args = @_ == 1 ? %{$_[0]} : @_;
678 # Since we need a (mapped) window for receiving a ClientMessage, we create
679 # one on the first call of sync_with_i3. It will be re-used in all
681 if (!exists($args{window_id}) &&
682 (!defined($_sync_window) || exists($args{no_cache}))) {
683 $_sync_window = open_window(
684 rect => [ -15, -15, 10, 10 ],
685 override_redirect => 1,
689 my $window_id = delete $args{window_id};
690 $window_id //= $_sync_window->id;
692 my $root = $x->get_root_window();
693 # Generate a random number to identify this particular ClientMessage.
694 my $myrnd = int(rand(255)) + 1;
696 # Generate a ClientMessage, see xcb_client_message_t
697 my $msg = pack "CCSLLLLLLL",
698 CLIENT_MESSAGE, # response_type
701 $root, # destination window
702 $x->atom(name => 'I3_SYNC')->id,
704 $window_id, # data[0]: our own window id
705 $myrnd, # data[1]: a random value to identify the request
710 # Send it to the root window -- since i3 uses the SubstructureRedirect
711 # event mask, it will get the ClientMessage.
712 $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
714 # now wait until the reply is here
715 return wait_for_event 2, sub {
718 return 0 unless $event->{response_type} == 161;
720 my ($win, $rnd) = unpack "LL", $event->{data};
721 return ($rnd == $myrnd);
725 =head2 exit_gracefully($pid, [ $socketpath ])
727 Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails.
729 If C<$socketpath> is not specified, C<get_socket_path()> will be called.
731 You only need to use this function if you have launched i3 on your own with
732 C<launch_with_config>. Otherwise, it will be automatically called when the
735 use i3test i3_autostart => 0;
736 my $pid = launch_with_config($config);
738 exit_gracefully($pid);
741 sub exit_gracefully {
742 my ($pid, $socketpath) = @_;
743 $socketpath ||= get_socket_path();
747 say "Exiting i3 cleanly...";
748 i3($socketpath)->command('exit')->recv;
754 or $tester->BAIL_OUT("could not kill i3");
757 if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
765 =head2 get_socket_path([ $cache ])
767 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
768 window. After the first call, this function will return a cached version of the
769 socket path unless you specify a false value for C<$cache>.
771 my $i3 = i3(get_socket_path());
772 $i3->command('nop test example')->recv;
776 my $i3 = i3(get_socket_path(0));
779 sub get_socket_path {
783 if ($cache && defined($_cached_socket_path)) {
784 return $_cached_socket_path;
787 my $atom = $x->atom(name => 'I3_SOCKET_PATH');
788 my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256);
789 my $reply = $x->get_property_reply($cookie->{sequence});
790 my $socketpath = $reply->{value};
791 if ($socketpath eq "/tmp/nested-$ENV{DISPLAY}") {
792 $socketpath .= '-activation';
794 $_cached_socket_path = $socketpath;
798 =head2 launch_with_config($config, [ $args ])
800 Launches a new i3 process with C<$config> as configuration file. Useful for
801 tests which test specific config file directives.
803 use i3test i3_autostart => 0;
806 # i3 config file (v4)
807 for_window [class="borderless"] border none
808 for_window [title="special borderless title"] border none
811 my $pid = launch_with_config($config);
815 exit_gracefully($pid);
818 sub launch_with_config {
819 my ($config, %args) = @_;
821 $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
823 $args{dont_create_temp_dir} //= 0;
825 my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
827 if ($config ne '-default') {
830 open(my $conf_fh, '<', './i3-test.config')
831 or $tester->BAIL_OUT("could not open default config: $!");
833 say $fh scalar <$conf_fh>;
836 say $fh "ipc-socket $tmp_socket_path"
837 unless $args{dont_add_socket_path};
841 my $cv = AnyEvent->condvar;
842 $i3_pid = activate_i3(
843 unix_socket_path => "$tmp_socket_path-activation",
844 display => $ENV{DISPLAY},
845 configfile => $tmpfile,
846 outdir => $ENV{OUTDIR},
847 testname => $ENV{TESTNAME},
848 valgrind => $ENV{VALGRIND},
849 strace => $ENV{STRACE},
850 xtrace => $ENV{XTRACE},
851 restart => $ENV{RESTART},
853 dont_create_temp_dir => $args{dont_create_temp_dir},
856 # force update of the cached socket path in lib/i3test
857 # as soon as i3 has started
858 $cv->cb(sub { get_socket_path(0) });
860 return $cv if $args{dont_block};
862 # blockingly wait until i3 is ready
870 Michael Stapelberg <michael@i3wm.org>
875 use parent 'X11::XCB::Connection';
879 i3test::sync_with_i3();
881 return $self->SUPER::input_focus(@_);