2 # vim:ts=4:sw=4:expandtab
3 use strict; use warnings;
5 use File::Temp qw(tmpnam tempfile tempdir);
10 use lib qw(@abs_top_srcdir@/AnyEvent-I3/blib/lib);
12 use List::Util qw(first);
13 use Time::HiRes qw(sleep);
15 use Scalar::Util qw(blessed);
17 use i3test::Util qw(slurp);
54 i3test - Testcase setup module
62 my $ws = fresh_workspace;
63 is_num_children($ws, 0, 'no containers on this workspace yet');
65 is_num_children($ws, 1, 'one container after "open"');
71 This module is used in every i3 testcase and takes care of automatically
72 starting i3 before any test instructions run. It also saves you typing of lots
73 of boilerplate in every test file.
76 i3test automatically "use"s C<Test::More>, C<Data::Dumper>, C<AnyEvent::I3>,
77 C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
78 to you in your testcase.
80 See also C<i3test::Test> (L<http://build.i3wm.org/docs/lib-i3test-test.html>)
81 which provides additional test instructions (like C<ok> or C<is>).
85 my $tester = Test::Builder->new();
86 my $_cached_socket_path = undef;
87 my $_sync_window = undef;
88 my $tmp_socket_path = undef;
95 return $window_count++;
103 # Skip the remaining cleanup for testcases which set i3_autostart => 0:
104 return if !defined($i3_pid) && !$i3_autostart;
106 # don't trigger SIGCHLD handler
109 # From perldoc -v '$?':
110 # Inside an "END" subroutine $? contains the value
111 # that is going to be given to "exit()".
113 # Since waitpid sets $?, we need to localize it,
114 # otherwise TAP would be misinterpreted our return status
117 # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
118 # files are not written)
119 if ($ENV{COVERAGE} || $ENV{VALGRIND}) {
120 exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}");
124 or $tester->BAIL_OUT("could not kill i3");
131 my ($class, %args) = @_;
134 $i3_autostart = delete($args{i3_autostart}) // 1;
135 my $i3_config = delete($args{i3_config}) // '-default';
137 my $cv = launch_with_config($i3_config, dont_block => 1)
140 my $test_more_args = '';
141 $test_more_args = join(' ', 'qw(', %args, ')') if keys %args;
145 use Test::More $test_more_args;
148 use Time::HiRes qw(sleep);
151 $tester->BAIL_OUT("$@") if $@;
152 feature->import(":5.10");
156 $x ||= i3test::X11->new;
157 # set the pointer to a predictable position in case a previous test has
159 $x->root->warp_pointer(0, 0);
160 $cv->recv if $i3_autostart;
163 goto \&Exporter::import;
168 =head2 wait_for_event($timeout, $callback)
170 Waits for the next event and calls the given callback for every event to
171 determine if this is the event we are waiting for.
173 Can be used to wait until a window is mapped, until a ClientMessage is
176 wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
180 my ($timeout, $cb) = @_;
186 # unfortunately, there is no constant for this
189 my $guard = AE::io $x->get_file_descriptor, $ae_read, sub {
190 while (defined(my $event = $x->poll_for_event)) {
198 # Trigger timeout after $timeout seconds (can be fractional)
199 my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) };
201 my $result = $cv->recv;
207 =head2 wait_for_map($window)
209 Thin wrapper around wait_for_event which waits for MAP_NOTIFY.
210 Make sure to include 'structure_notify' in the window’s event_mask attribute.
212 This function is called by C<open_window>, so in most cases, you don’t need to
213 call it on your own. If you need special setup of the window before mapping,
214 you might have to map it on your own and use this function:
216 my $window = open_window(dont_map => 1);
217 # Do something special with the window first
220 # Now map it and wait until it’s been mapped
222 wait_for_map($window);
227 my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
228 wait_for_event 4, sub {
229 $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id
233 =head2 wait_for_unmap($window)
235 Wrapper around C<wait_for_event> which waits for UNMAP_NOTIFY. Also calls
236 C<sync_with_i3> to make sure i3 also picked up and processed the UnmapNotify
239 my $ws = fresh_workspace;
240 my $window = open_window;
241 is_num_children($ws, 1, 'one window on workspace');
244 is_num_children($ws, 0, 'no more windows on this workspace');
249 # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
250 wait_for_event 4, sub {
251 $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id
256 =head2 open_window([ $args ])
258 Opens a new window (see C<X11::XCB::Window>), maps it, waits until it got mapped
259 and synchronizes with i3.
261 The following arguments can be passed:
267 The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with
272 An arrayref with 4 members specifying the initial geometry (position and size)
273 of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100
274 with width=70 and height=50.
276 Note that this is entirely irrelevant for tiling windows.
278 =item background_color
280 The background pixel color of the window, formatted as "#rrggbb", like HTML
281 color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually
282 watching the testcases.
286 An arrayref containing strings which describe the X11 event mask we use for that
287 window. The default is C<< [ 'structure_notify' ] >>.
291 The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window
292 n" with n being replaced by a counter to keep windows apart.
296 Set to a true value to avoid mapping the window (making it visible).
300 A coderef which is called before the window is mapped (unless C<dont_map> is
301 true). The freshly created C<$window> is passed as C<$_> and as the first
306 The default values are equivalent to this call:
309 class => WINDOW_CLASS_INPUT_OUTPUT
310 rect => [ 0, 0, 30, 30 ]
311 background_color => '#c0c0c0'
312 event_mask => [ 'structure_notify' ]
316 Usually, though, calls are simpler:
318 my $top_window = open_window;
320 To identify the resulting window object in i3 commands, use the id property:
322 my $top_window = open_window;
323 cmd '[id="' . $top_window->id . '"] kill';
327 my %args = @_ == 1 ? %{$_[0]} : @_;
329 my $dont_map = delete $args{dont_map};
330 my $before_map = delete $args{before_map};
332 $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
333 $args{rect} //= [ 0, 0, 30, 30 ];
334 $args{background_color} //= '#c0c0c0';
335 $args{event_mask} //= [ 'structure_notify' ];
336 $args{name} //= 'Window ' . counter_window();
338 my $window = $x->root->create_child(%args);
339 $window->add_hint('input');
342 # TODO: investigate why _create is not needed
344 $before_map->($window) for $window;
347 return $window if $dont_map;
350 wait_for_map($window);
354 =head2 open_floating_window([ $args ])
356 Thin wrapper around open_window which sets window_type to
357 C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating.
359 The arguments are the same as those of C<open_window>.
362 sub open_floating_window {
363 my %args = @_ == 1 ? %{$_[0]} : @_;
365 $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY');
367 return open_window(\%args);
373 my $reply = $i3->command('open')->recv;
374 return $reply->[0]->{id};
377 =head2 get_workspace_names()
379 Returns an arrayref containing the name of every workspace (regardless of its
380 output) which currently exists.
382 my $workspace_names = get_workspace_names;
383 is(scalar @$workspace_names, 3, 'three workspaces exist currently');
386 sub get_workspace_names {
387 my $i3 = i3(get_socket_path());
388 my $tree = $i3->get_tree->recv;
389 my @outputs = @{$tree->{nodes}};
391 for my $output (@outputs) {
392 next if $output->{name} eq '__i3';
393 # get the first CT_CON of each output
394 my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
395 @cons = (@cons, @{$content->{nodes}});
397 [ map { $_->{name} } @cons ]
400 =head2 get_unused_workspace
402 Returns a workspace name which has not yet been used. See also
403 C<fresh_workspace> which directly switches to an unused workspace.
405 my $ws = get_unused_workspace;
409 sub get_unused_workspace {
410 my @names = get_workspace_names();
412 do { $tmp = tmpnam() } while ((scalar grep { $_ eq $tmp } @names) > 0);
416 =head2 fresh_workspace([ $args ])
418 Switches to an unused workspace and returns the name of that workspace.
420 Optionally switches to the specified output first.
422 my $ws = fresh_workspace;
424 # Get a fresh workspace on the second output.
425 my $ws = fresh_workspace(output => 1);
428 sub fresh_workspace {
430 if (exists($args{output})) {
431 my $i3 = i3(get_socket_path());
432 my $tree = $i3->get_tree->recv;
433 my $output = first { $_->{name} eq "fake-$args{output}" }
435 die "BUG: Could not find output $args{output}" unless defined($output);
436 # Get the focused workspace on that output and switch to it.
437 my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
438 my $focused = $content->{focus}->[0];
439 my $workspace = first { $_->{id} == $focused } @{$content->{nodes}};
440 $workspace = $workspace->{name};
441 cmd("workspace $workspace");
444 my $unused = get_unused_workspace;
445 cmd("workspace $unused");
449 =head2 get_ws($workspace)
451 Returns the container (from the i3 layout tree) which represents C<$workspace>.
453 my $ws = fresh_workspace;
454 my $ws_con = get_ws($ws);
455 ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent');
457 Here is an example which counts the number of urgent containers recursively,
458 starting from the workspace container:
463 my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}});
464 my $urgent = grep { $_->{urgent} } @children;
465 $urgent += count_urgent($_) for @children;
468 my $urgent = count_urgent(get_ws($ws));
469 is($urgent, 3, "three urgent windows on workspace $ws");
475 my $i3 = i3(get_socket_path());
476 my $tree = $i3->get_tree->recv;
478 my @outputs = @{$tree->{nodes}};
480 for my $output (@outputs) {
481 # get the first CT_CON of each output
482 my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
483 @workspaces = (@workspaces, @{$content->{nodes}});
486 # as there can only be one workspace with this name, we can safely
487 # return the first entry
488 return first { $_->{name} eq $name } @workspaces;
491 =head2 get_ws_content($workspace)
493 Returns the content (== tree, starting from the node of a workspace)
494 of a workspace. If called in array context, also includes the focus
495 stack of the workspace.
497 my $nodes = get_ws_content($ws);
498 is(scalar @$nodes, 4, 'there are four containers at workspace-level');
500 Or, in array context:
502 my $window = open_window;
503 my ($nodes, $focus) = get_ws_content($ws);
504 is($focus->[0], $window->id, 'newly opened window focused');
506 Note that this function does not do recursion for you! It only returns the
507 containers B<on workspace level>. If you want to work with all containers (even
508 nested ones) on a workspace, you have to use recursion:
510 # NB: This function does not count floating windows
515 for my $con (@$nodes) {
516 $urgent++ if $con->{urgent};
517 $urgent += count_urgent($con->{nodes});
522 my $nodes = get_ws_content($ws);
523 my $urgent = count_urgent($nodes);
524 is($urgent, 3, "three urgent windows on workspace $ws");
526 If you also want to deal with floating windows, you have to use C<get_ws>
527 instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own.
532 my $con = get_ws($name);
533 return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes};
536 =head2 get_focused($workspace)
538 Returns the container ID of the currently focused container on C<$workspace>.
540 Note that the container ID is B<not> the X11 window ID, so comparing the result
541 of C<get_focused> with a window's C<< ->{id} >> property does B<not> work.
543 my $ws = fresh_workspace;
544 my $first_window = open_window;
545 my $first_id = get_focused();
547 my $second_window = open_window;
548 my $second_id = get_focused();
552 is(get_focused($ws), $first_id, 'second window focused');
557 my $con = get_ws($ws);
559 my @focused = @{$con->{focus}};
561 while (@focused > 0) {
563 last unless defined($con->{focus});
564 @focused = @{$con->{focus}};
565 my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
572 =head2 get_dock_clients([ $dockarea ])
574 Returns an array of all dock containers in C<$dockarea> (one of "top" or
575 "bottom"). If C<$dockarea> is not specified, returns an array of all dock
576 containers in any dockarea.
578 my @docked = get_dock_clients;
579 is(scalar @docked, 0, 'no dock clients yet');
582 sub get_dock_clients {
585 my $tree = i3(get_socket_path())->get_tree->recv;
586 my @outputs = @{$tree->{nodes}};
587 # Children of all dockareas
589 for my $output (@outputs) {
590 if (!defined($which)) {
591 @docked = (@docked, map { @{$_->{nodes}} }
592 grep { $_->{type} eq 'dockarea' }
593 @{$output->{nodes}});
594 } elsif ($which eq 'top') {
595 my $first = first { $_->{type} eq 'dockarea' } @{$output->{nodes}};
596 @docked = (@docked, @{$first->{nodes}}) if defined($first);
597 } elsif ($which eq 'bottom') {
598 my @matching = grep { $_->{type} eq 'dockarea' } @{$output->{nodes}};
599 my $last = $matching[-1];
600 @docked = (@docked, @{$last->{nodes}}) if defined($last);
608 Sends the specified command to i3 and returns the output.
610 my $ws = unused_workspace;
616 i3(get_socket_path())->command(@_)->recv
619 =head2 workspace_exists($workspace)
621 Returns true if C<$workspace> is the name of an existing workspace.
623 my $old_ws = focused_ws;
624 # switch away from where we currently are
627 ok(workspace_exists($old_ws), 'old workspace still exists');
630 sub workspace_exists {
632 (scalar grep { $_ eq $name } @{get_workspace_names()}) > 0;
637 Returns the name of the currently focused workspace.
640 is($ws, '1', 'i3 starts on workspace 1');
644 my $i3 = i3(get_socket_path());
645 my $tree = $i3->get_tree->recv;
646 my $focused = $tree->{focus}->[0];
647 my $output = first { $_->{id} == $focused } @{$tree->{nodes}};
648 my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
649 my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}};
650 return $first->{name}
653 =head2 sync_with_i3([ $args ])
655 Sends an I3_SYNC ClientMessage with a random value to the root window.
656 i3 will reply with the same value, but, due to the order of events it
657 processes, only after all other events are done.
659 This can be used to ensure the results of a cmd 'focus left' are pushed to
660 X11 and that C<< $x->input_focus >> returns the correct value afterwards.
662 See also L<http://build.i3wm.org/docs/testsuite.html> for a longer explanation.
664 my $window = open_window;
665 $window->add_hint('urgency');
666 # Ensure i3 picked up the change
669 The only time when you need to use the C<no_cache> argument is when you just
670 killed your own X11 connection:
673 # We need to re-establish the X11 connection which we just killed :).
674 $x = i3test::X11->new;
675 sync_with_i3(no_cache => 1);
679 my %args = @_ == 1 ? %{$_[0]} : @_;
681 # Since we need a (mapped) window for receiving a ClientMessage, we create
682 # one on the first call of sync_with_i3. It will be re-used in all
684 if (!exists($args{window_id}) &&
685 (!defined($_sync_window) || exists($args{no_cache}))) {
686 $_sync_window = open_window(
687 rect => [ -15, -15, 10, 10 ],
688 override_redirect => 1,
692 my $window_id = delete $args{window_id};
693 $window_id //= $_sync_window->id;
695 my $root = $x->get_root_window();
696 # Generate a random number to identify this particular ClientMessage.
697 my $myrnd = int(rand(255)) + 1;
699 # Generate a ClientMessage, see xcb_client_message_t
700 my $msg = pack "CCSLLLLLLL",
701 CLIENT_MESSAGE, # response_type
704 $root, # destination window
705 $x->atom(name => 'I3_SYNC')->id,
707 $window_id, # data[0]: our own window id
708 $myrnd, # data[1]: a random value to identify the request
713 # Send it to the root window -- since i3 uses the SubstructureRedirect
714 # event mask, it will get the ClientMessage.
715 $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
717 return $myrnd if $args{dont_wait_for_event};
719 # now wait until the reply is here
720 return wait_for_event 4, sub {
723 return 0 unless $event->{response_type} == 161;
725 my ($win, $rnd) = unpack "LL", $event->{data};
726 return ($rnd == $myrnd);
730 =head2 exit_gracefully($pid, [ $socketpath ])
732 Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails.
734 If C<$socketpath> is not specified, C<get_socket_path()> will be called.
736 You only need to use this function if you have launched i3 on your own with
737 C<launch_with_config>. Otherwise, it will be automatically called when the
740 use i3test i3_autostart => 0;
741 my $pid = launch_with_config($config);
743 exit_gracefully($pid);
746 sub exit_gracefully {
747 my ($pid, $socketpath) = @_;
748 $socketpath ||= get_socket_path();
752 say "Exiting i3 cleanly...";
753 i3($socketpath)->command('exit')->recv;
759 or $tester->BAIL_OUT("could not kill i3");
762 if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
770 =head2 get_socket_path([ $cache ])
772 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
773 window. After the first call, this function will return a cached version of the
774 socket path unless you specify a false value for C<$cache>.
776 my $i3 = i3(get_socket_path());
777 $i3->command('nop test example')->recv;
781 my $i3 = i3(get_socket_path(0));
784 sub get_socket_path {
788 if ($cache && defined($_cached_socket_path)) {
789 return $_cached_socket_path;
791 my $socketpath = i3test::Util::get_socket_path($x);
792 $_cached_socket_path = $socketpath;
796 =head2 launch_with_config($config, [ $args ])
798 Launches a new i3 process with C<$config> as configuration file. Useful for
799 tests which test specific config file directives.
801 use i3test i3_autostart => 0;
804 # i3 config file (v4)
805 for_window [class="borderless"] border none
806 for_window [title="special borderless title"] border none
809 my $pid = launch_with_config($config);
813 exit_gracefully($pid);
816 sub launch_with_config {
817 my ($config, %args) = @_;
819 $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
821 $args{dont_create_temp_dir} //= 0;
822 $args{validate_config} //= 0;
824 my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
826 say $fh "ipc-socket $tmp_socket_path"
827 unless $args{dont_add_socket_path};
829 if ($config ne '-default') {
832 open(my $conf_fh, '<', '@abs_top_srcdir@/testcases/i3-test.config')
833 or $tester->BAIL_OUT("could not open default config: $!");
835 say $fh scalar <$conf_fh>;
840 my $cv = AnyEvent->condvar;
841 $i3_pid = activate_i3(
842 unix_socket_path => "$tmp_socket_path-activation",
843 display => $ENV{DISPLAY},
844 configfile => $tmpfile,
845 outdir => $ENV{OUTDIR},
846 testname => $ENV{TESTNAME},
847 valgrind => $ENV{VALGRIND},
848 strace => $ENV{STRACE},
849 xtrace => $ENV{XTRACE},
850 restart => $ENV{RESTART},
852 dont_create_temp_dir => $args{dont_create_temp_dir},
853 validate_config => $args{validate_config},
854 inject_randr15 => $args{inject_randr15},
855 inject_randr15_outputinfo => $args{inject_randr15_outputinfo},
858 # If we called i3 with -C, we wait for it to exit and then return as
859 # there's nothing else we need to do.
860 if ($args{validate_config}) {
864 # We need this since exit_gracefully will not be called in this case.
867 return ${^CHILD_ERROR_NATIVE};
870 # force update of the cached socket path in lib/i3test
871 # as soon as i3 has started
872 $cv->cb(sub { get_socket_path(0) });
874 return $cv if $args{dont_block};
876 # blockingly wait until i3 is ready
884 Returns the content of the log file for the current test.
888 my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}";
889 return slurp($logfile);
892 =head2 kill_all_windows
894 Kills all windows to clean up between tests.
897 sub kill_all_windows {
898 # Sync in case not all windows are managed by i3 just yet.
900 cmd '[title=".*"] kill';
905 Michael Stapelberg <michael@i3wm.org>
910 use parent 'X11::XCB::Connection';
914 i3test::sync_with_i3();
916 return $self->SUPER::input_focus(@_);