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;
320 my %args = @_ == 1 ? %{$_[0]} : @_;
322 my $dont_map = delete $args{dont_map};
323 my $before_map = delete $args{before_map};
325 $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
326 $args{rect} //= [ 0, 0, 30, 30 ];
327 $args{background_color} //= '#c0c0c0';
328 $args{event_mask} //= [ 'structure_notify' ];
329 $args{name} //= 'Window ' . counter_window();
331 my $window = $x->root->create_child(%args);
334 # TODO: investigate why _create is not needed
336 $before_map->($window) for $window;
339 return $window if $dont_map;
342 wait_for_map($window);
346 =head2 open_floating_window([ $args ])
348 Thin wrapper around open_window which sets window_type to
349 C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating.
351 The arguments are the same as those of C<open_window>.
354 sub open_floating_window {
355 my %args = @_ == 1 ? %{$_[0]} : @_;
357 $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY');
359 return open_window(\%args);
365 my $reply = $i3->command('open')->recv;
366 return $reply->[0]->{id};
369 =head2 get_workspace_names()
371 Returns an arrayref containing the name of every workspace (regardless of its
372 output) which currently exists.
374 my $workspace_names = get_workspace_names;
375 is(scalar @$workspace_names, 3, 'three workspaces exist currently');
378 sub get_workspace_names {
379 my $i3 = i3(get_socket_path());
380 my $tree = $i3->get_tree->recv;
381 my @outputs = @{$tree->{nodes}};
383 for my $output (@outputs) {
384 next if $output->{name} eq '__i3';
385 # get the first CT_CON of each output
386 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
387 @cons = (@cons, @{$content->{nodes}});
389 [ map { $_->{name} } @cons ]
392 =head2 get_unused_workspace
394 Returns a workspace name which has not yet been used. See also
395 C<fresh_workspace> which directly switches to an unused workspace.
397 my $ws = get_unused_workspace;
401 sub get_unused_workspace {
402 my @names = get_workspace_names();
404 do { $tmp = tmpnam() } while ($tmp ~~ @names);
408 =head2 fresh_workspace([ $args ])
410 Switches to an unused workspace and returns the name of that workspace.
412 Optionally switches to the specified output first.
414 my $ws = fresh_workspace;
416 # Get a fresh workspace on the second output.
417 my $ws = fresh_workspace(output => 1);
420 sub fresh_workspace {
422 if (exists($args{output})) {
423 my $i3 = i3(get_socket_path());
424 my $tree = $i3->get_tree->recv;
425 my $output = first { $_->{name} eq "fake-$args{output}" }
427 die "BUG: Could not find output $args{output}" unless defined($output);
428 # Get the focused workspace on that output and switch to it.
429 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
430 my $focused = $content->{focus}->[0];
431 my $workspace = first { $_->{id} == $focused } @{$content->{nodes}};
432 $workspace = $workspace->{name};
433 cmd("workspace $workspace");
436 my $unused = get_unused_workspace;
437 cmd("workspace $unused");
441 =head2 get_ws($workspace)
443 Returns the container (from the i3 layout tree) which represents C<$workspace>.
445 my $ws = fresh_workspace;
446 my $ws_con = get_ws($ws);
447 ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent');
449 Here is an example which counts the number of urgent containers recursively,
450 starting from the workspace container:
455 my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}});
456 my $urgent = grep { $_->{urgent} } @children;
457 $urgent += count_urgent($_) for @children;
460 my $urgent = count_urgent(get_ws($ws));
461 is($urgent, 3, "three urgent windows on workspace $ws");
467 my $i3 = i3(get_socket_path());
468 my $tree = $i3->get_tree->recv;
470 my @outputs = @{$tree->{nodes}};
472 for my $output (@outputs) {
473 # get the first CT_CON of each output
474 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
475 @workspaces = (@workspaces, @{$content->{nodes}});
478 # as there can only be one workspace with this name, we can safely
479 # return the first entry
480 return first { $_->{name} eq $name } @workspaces;
483 =head2 get_ws_content($workspace)
485 Returns the content (== tree, starting from the node of a workspace)
486 of a workspace. If called in array context, also includes the focus
487 stack of the workspace.
489 my $nodes = get_ws_content($ws);
490 is(scalar @$nodes, 4, 'there are four containers at workspace-level');
492 Or, in array context:
494 my $window = open_window;
495 my ($nodes, $focus) = get_ws_content($ws);
496 is($focus->[0], $window->id, 'newly opened window focused');
498 Note that this function does not do recursion for you! It only returns the
499 containers B<on workspace level>. If you want to work with all containers (even
500 nested ones) on a workspace, you have to use recursion:
502 # NB: This function does not count floating windows
507 for my $con (@$nodes) {
508 $urgent++ if $con->{urgent};
509 $urgent += count_urgent($con->{nodes});
514 my $nodes = get_ws_content($ws);
515 my $urgent = count_urgent($nodes);
516 is($urgent, 3, "three urgent windows on workspace $ws");
518 If you also want to deal with floating windows, you have to use C<get_ws>
519 instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own.
524 my $con = get_ws($name);
525 return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes};
528 =head2 get_focused($workspace)
530 Returns the container ID of the currently focused container on C<$workspace>.
532 Note that the container ID is B<not> the X11 window ID, so comparing the result
533 of C<get_focused> with a window's C<< ->{id} >> property does B<not> work.
535 my $ws = fresh_workspace;
536 my $first_window = open_window;
537 my $first_id = get_focused();
539 my $second_window = open_window;
540 my $second_id = get_focused();
544 is(get_focused($ws), $first_id, 'second window focused');
549 my $con = get_ws($ws);
551 my @focused = @{$con->{focus}};
553 while (@focused > 0) {
555 last unless defined($con->{focus});
556 @focused = @{$con->{focus}};
557 my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
564 =head2 get_dock_clients([ $dockarea ])
566 Returns an array of all dock containers in C<$dockarea> (one of "top" or
567 "bottom"). If C<$dockarea> is not specified, returns an array of all dock
568 containers in any dockarea.
570 my @docked = get_dock_clients;
571 is(scalar @docked, 0, 'no dock clients yet');
574 sub get_dock_clients {
577 my $tree = i3(get_socket_path())->get_tree->recv;
578 my @outputs = @{$tree->{nodes}};
579 # Children of all dockareas
581 for my $output (@outputs) {
582 if (!defined($which)) {
583 @docked = (@docked, map { @{$_->{nodes}} }
584 grep { $_->{type} == 5 }
585 @{$output->{nodes}});
586 } elsif ($which eq 'top') {
587 my $first = first { $_->{type} == 5 } @{$output->{nodes}};
588 @docked = (@docked, @{$first->{nodes}}) if defined($first);
589 } elsif ($which eq 'bottom') {
590 my @matching = grep { $_->{type} == 5 } @{$output->{nodes}};
591 my $last = $matching[-1];
592 @docked = (@docked, @{$last->{nodes}}) if defined($last);
600 Sends the specified command to i3.
602 my $ws = unused_workspace;
608 i3(get_socket_path())->command(@_)->recv
611 =head2 workspace_exists($workspace)
613 Returns true if C<$workspace> is the name of an existing workspace.
615 my $old_ws = focused_ws;
616 # switch away from where we currently are
619 ok(workspace_exists($old_ws), 'old workspace still exists');
622 sub workspace_exists {
624 ($name ~~ @{get_workspace_names()})
629 Returns the name of the currently focused workspace.
632 is($ws, '1', 'i3 starts on workspace 1');
636 my $i3 = i3(get_socket_path());
637 my $tree = $i3->get_tree->recv;
638 my $focused = $tree->{focus}->[0];
639 my $output = first { $_->{id} == $focused } @{$tree->{nodes}};
640 my $content = first { $_->{type} == 2 } @{$output->{nodes}};
641 my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}};
642 return $first->{name}
645 =head2 sync_with_i3([ $args ])
647 Sends an I3_SYNC ClientMessage with a random value to the root window.
648 i3 will reply with the same value, but, due to the order of events it
649 processes, only after all other events are done.
651 This can be used to ensure the results of a cmd 'focus left' are pushed to
652 X11 and that C<< $x->input_focus >> returns the correct value afterwards.
654 See also L<http://build.i3wm.org/docs/testsuite.html> for a longer explanation.
656 my $window = open_window;
657 $window->add_hint('urgency');
658 # Ensure i3 picked up the change
661 The only time when you need to use the C<no_cache> argument is when you just
662 killed your own X11 connection:
665 # We need to re-establish the X11 connection which we just killed :).
666 $x = i3test::X11->new;
667 sync_with_i3(no_cache => 1);
671 my %args = @_ == 1 ? %{$_[0]} : @_;
673 # Since we need a (mapped) window for receiving a ClientMessage, we create
674 # one on the first call of sync_with_i3. It will be re-used in all
676 if (!exists($args{window_id}) &&
677 (!defined($_sync_window) || exists($args{no_cache}))) {
678 $_sync_window = open_window(
679 rect => [ -15, -15, 10, 10 ],
680 override_redirect => 1,
684 my $window_id = delete $args{window_id};
685 $window_id //= $_sync_window->id;
687 my $root = $x->get_root_window();
688 # Generate a random number to identify this particular ClientMessage.
689 my $myrnd = int(rand(255)) + 1;
691 # Generate a ClientMessage, see xcb_client_message_t
692 my $msg = pack "CCSLLLLLLL",
693 CLIENT_MESSAGE, # response_type
696 $root, # destination window
697 $x->atom(name => 'I3_SYNC')->id,
699 $window_id, # data[0]: our own window id
700 $myrnd, # data[1]: a random value to identify the request
705 # Send it to the root window -- since i3 uses the SubstructureRedirect
706 # event mask, it will get the ClientMessage.
707 $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
709 # now wait until the reply is here
710 return wait_for_event 2, sub {
713 return 0 unless $event->{response_type} == 161;
715 my ($win, $rnd) = unpack "LL", $event->{data};
716 return ($rnd == $myrnd);
720 =head2 exit_gracefully($pid, [ $socketpath ])
722 Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails.
724 If C<$socketpath> is not specified, C<get_socket_path()> will be called.
726 You only need to use this function if you have launched i3 on your own with
727 C<launch_with_config>. Otherwise, it will be automatically called when the
730 use i3test i3_autostart => 0;
731 my $pid = launch_with_config($config);
733 exit_gracefully($pid);
736 sub exit_gracefully {
737 my ($pid, $socketpath) = @_;
738 $socketpath ||= get_socket_path();
742 say "Exiting i3 cleanly...";
743 i3($socketpath)->command('exit')->recv;
749 or $tester->BAIL_OUT("could not kill i3");
752 if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
760 =head2 get_socket_path([ $cache ])
762 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
763 window. After the first call, this function will return a cached version of the
764 socket path unless you specify a false value for C<$cache>.
766 my $i3 = i3(get_socket_path());
767 $i3->command('nop test example')->recv;
771 my $i3 = i3(get_socket_path(0));
774 sub get_socket_path {
778 if ($cache && defined($_cached_socket_path)) {
779 return $_cached_socket_path;
782 my $atom = $x->atom(name => 'I3_SOCKET_PATH');
783 my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256);
784 my $reply = $x->get_property_reply($cookie->{sequence});
785 my $socketpath = $reply->{value};
786 if ($socketpath eq "/tmp/nested-$ENV{DISPLAY}") {
787 $socketpath .= '-activation';
789 $_cached_socket_path = $socketpath;
793 =head2 launch_with_config($config, [ $args ])
795 Launches a new i3 process with C<$config> as configuration file. Useful for
796 tests which test specific config file directives.
798 use i3test i3_autostart => 0;
801 # i3 config file (v4)
802 for_window [class="borderless"] border none
803 for_window [title="special borderless title"] border none
806 my $pid = launch_with_config($config);
810 exit_gracefully($pid);
813 sub launch_with_config {
814 my ($config, %args) = @_;
816 $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
818 $args{dont_create_temp_dir} //= 0;
820 my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
822 if ($config ne '-default') {
825 open(my $conf_fh, '<', './i3-test.config')
826 or $tester->BAIL_OUT("could not open default config: $!");
828 say $fh scalar <$conf_fh>;
831 say $fh "ipc-socket $tmp_socket_path"
832 unless $args{dont_add_socket_path};
836 my $cv = AnyEvent->condvar;
837 $i3_pid = activate_i3(
838 unix_socket_path => "$tmp_socket_path-activation",
839 display => $ENV{DISPLAY},
840 configfile => $tmpfile,
841 outdir => $ENV{OUTDIR},
842 testname => $ENV{TESTNAME},
843 valgrind => $ENV{VALGRIND},
844 strace => $ENV{STRACE},
845 xtrace => $ENV{XTRACE},
846 restart => $ENV{RESTART},
848 dont_create_temp_dir => $args{dont_create_temp_dir},
851 # force update of the cached socket path in lib/i3test
852 # as soon as i3 has started
853 $cv->cb(sub { get_socket_path(0) });
855 return $cv if $args{dont_block};
857 # blockingly wait until i3 is ready
865 Michael Stapelberg <michael@i3wm.org>
870 use parent 'X11::XCB::Connection';
874 i3test::sync_with_i3();
876 return $self->SUPER::input_focus(@_);