]> git.sur5r.net Git - i3/i3/blob - testcases/lib/i3test.pm.in
Merge branch 'release-4.16.1'
[i3/i3] / testcases / lib / i3test.pm.in
1 package i3test;
2 # vim:ts=4:sw=4:expandtab
3 use strict; use warnings;
4
5 use File::Temp qw(tmpnam tempfile tempdir);
6 use Test::Builder;
7 use X11::XCB::Rect;
8 use X11::XCB::Window;
9 use X11::XCB qw(:all);
10 use lib qw(@abs_top_srcdir@/AnyEvent-I3/blib/lib);
11 use AnyEvent::I3;
12 use List::Util qw(first);
13 use Time::HiRes qw(sleep);
14 use Cwd qw(abs_path);
15 use POSIX ':sys_wait_h';
16 use Scalar::Util qw(blessed);
17 use SocketActivation;
18 use i3test::Util qw(slurp);
19
20 use v5.10;
21
22 # preload
23 use Test::More ();
24 use Data::Dumper ();
25
26 use Exporter ();
27 our @EXPORT = qw(
28     get_workspace_names
29     get_output_for_workspace
30     get_unused_workspace
31     fresh_workspace
32     get_ws_content
33     get_ws
34     get_focused
35     open_empty_con
36     open_window
37     open_floating_window
38     get_dock_clients
39     cmd
40     sync_with_i3
41     exit_gracefully
42     exit_forcefully
43     workspace_exists
44     focused_ws
45     get_socket_path
46     launch_with_config
47     get_i3_log
48     wait_for_event
49     wait_for_map
50     wait_for_unmap
51     $x
52     kill_all_windows
53     events_for
54     listen_for_binding
55     is_net_wm_state_focused
56 );
57
58 =head1 NAME
59
60 i3test - Testcase setup module
61
62 =encoding utf-8
63
64 =head1 SYNOPSIS
65
66   use i3test;
67
68   my $ws = fresh_workspace;
69   is_num_children($ws, 0, 'no containers on this workspace yet');
70   cmd 'open';
71   is_num_children($ws, 1, 'one container after "open"');
72
73   done_testing;
74
75 =head1 DESCRIPTION
76
77 This module is used in every i3 testcase and takes care of automatically
78 starting i3 before any test instructions run. It also saves you typing of lots
79 of boilerplate in every test file.
80
81
82 i3test automatically "use"s C<Test::More>, C<Data::Dumper>, C<AnyEvent::I3>,
83 C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
84 to you in your testcase.
85
86 See also C<i3test::Test> (L<https://build.i3wm.org/docs/lib-i3test-test.html>)
87 which provides additional test instructions (like C<ok> or C<is>).
88
89 =cut
90
91 my $tester = Test::Builder->new();
92 my $_cached_socket_path = undef;
93 my $_sync_window = undef;
94 my $tmp_socket_path = undef;
95
96 our $x;
97
98 BEGIN {
99     my $window_count = 0;
100     sub counter_window {
101         return $window_count++;
102     }
103 }
104
105 my $i3_pid;
106 my $i3_autostart;
107
108 END {
109     # Skip the remaining cleanup for testcases which set i3_autostart => 0:
110     return if !defined($i3_pid) && !$i3_autostart;
111
112     # don't trigger SIGCHLD handler
113     local $SIG{CHLD};
114
115     # From perldoc -v '$?':
116     # Inside an "END" subroutine $? contains the value
117     # that is going to be given to "exit()".
118     #
119     # Since waitpid sets $?, we need to localize it,
120     # otherwise TAP would be misinterpreted our return status
121     local $?;
122
123     # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
124     # files are not written)
125     if ($ENV{COVERAGE} || $ENV{VALGRIND}) {
126         exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}");
127
128     } else {
129         kill(-9, $i3_pid)
130             or $tester->BAIL_OUT("could not kill i3: $!");
131
132         waitpid $i3_pid, 0;
133     }
134 }
135
136 sub import {
137     my ($class, %args) = @_;
138     my $pkg = caller;
139
140     $x ||= i3test::X11->new;
141     # set the pointer to a predictable position in case a previous test has
142     # disturbed it
143     $x->warp_pointer(
144         0, # src_window (None)
145         $x->get_root_window(), # dst_window (None)
146         0, # src_x
147         0, # src_y
148         0, # src_width
149         0, # src_height
150         0, # dst_x
151         0); # dst_y
152     # Synchronize with X11 to ensure the pointer has been warped before i3
153     # starts up.
154     $x->get_input_focus_reply($x->get_input_focus()->{sequence});
155
156     $i3_autostart = delete($args{i3_autostart}) // 1;
157     my $i3_config = delete($args{i3_config}) // '-default';
158
159     my $cv = launch_with_config($i3_config, dont_block => 1)
160         if $i3_autostart;
161
162     my $test_more_args = '';
163     $test_more_args = join(' ', 'qw(', %args, ')') if keys %args;
164     local $@;
165     eval << "__";
166 package $pkg;
167 use Test::More $test_more_args;
168 use Data::Dumper;
169 use AnyEvent::I3;
170 use Time::HiRes qw(sleep);
171 use i3test::Test;
172 __
173     $tester->BAIL_OUT("$@") if $@;
174     feature->import(":5.10");
175     strict->import;
176     warnings->import;
177
178     $cv->recv if $i3_autostart;
179
180     @_ = ($class);
181     goto \&Exporter::import;
182 }
183
184 =head1 EXPORT
185
186 =head2 wait_for_event($timeout, $callback)
187
188 Waits for the next event and calls the given callback for every event to
189 determine if this is the event we are waiting for.
190
191 Can be used to wait until a window is mapped, until a ClientMessage is
192 received, etc.
193
194   wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
195
196 =cut
197 sub wait_for_event {
198     my ($timeout, $cb) = @_;
199
200     $x->flush;
201
202     while (defined(my $event = $x->wait_for_event)) {
203         return 1 if $cb->($event);
204     }
205 }
206
207 =head2 wait_for_map($window)
208
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.
211
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:
215
216   my $window = open_window(dont_map => 1);
217   # Do something special with the window first
218   # …
219
220   # Now map it and wait until it’s been mapped
221   $window->map;
222   wait_for_map($window);
223
224 =cut
225 sub wait_for_map {
226     my ($win) = @_;
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
230     };
231 }
232
233 =head2 wait_for_unmap($window)
234
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
237 event.
238
239   my $ws = fresh_workspace;
240   my $window = open_window;
241   is_num_children($ws, 1, 'one window on workspace');
242   $window->unmap;
243   wait_for_unmap;
244   is_num_children($ws, 0, 'no more windows on this workspace');
245
246 =cut
247 sub wait_for_unmap {
248     my ($win) = @_;
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
252     };
253     sync_with_i3();
254 }
255
256 =head2 open_window([ $args ])
257
258 Opens a new window (see C<X11::XCB::Window>), maps it, waits until it got mapped
259 and synchronizes with i3.
260
261 The following arguments can be passed:
262
263 =over 4
264
265 =item class
266
267 The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with
268 the WM_CLASS!
269
270 =item rect
271
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.
275
276 Note that this is entirely irrelevant for tiling windows.
277
278 =item background_color
279
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.
283
284 =item event_mask
285
286 An arrayref containing strings which describe the X11 event mask we use for that
287 window. The default is C<< [ 'structure_notify' ] >>.
288
289 =item name
290
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.
293
294 =item dont_map
295
296 Set to a true value to avoid mapping the window (making it visible).
297
298 =item before_map
299
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
302 argument.
303
304 =back
305
306 The default values are equivalent to this call:
307
308   open_window(
309     class => WINDOW_CLASS_INPUT_OUTPUT
310     rect => [ 0, 0, 30, 30 ]
311     background_color => '#c0c0c0'
312     event_mask => [ 'structure_notify' ]
313     name => 'Window <n>'
314   );
315
316 Usually, though, calls are simpler:
317
318   my $top_window = open_window;
319
320 To identify the resulting window object in i3 commands, use the id property:
321
322   my $top_window = open_window;
323   cmd '[id="' . $top_window->id . '"] kill';
324
325 =cut
326 sub open_window {
327     my %args = @_ == 1 ? %{$_[0]} : @_;
328
329     my $dont_map = delete $args{dont_map};
330     my $before_map = delete $args{before_map};
331
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();
337
338     my $window = $x->root->create_child(%args);
339     $window->add_hint('input');
340
341     if ($before_map) {
342         # TODO: investigate why _create is not needed
343         $window->_create;
344         $before_map->($window) for $window;
345     }
346
347     return $window if $dont_map;
348
349     $window->map;
350     wait_for_map($window);
351
352     # MapWindow is sent before i3 even starts rendering: the window is placed at
353     # temporary off-screen coordinates first, and x_push_changes() sends further
354     # X11 requests to set focus etc. Hence, we sync with i3 before continuing.
355     sync_with_i3();
356
357     return $window;
358 }
359
360 =head2 open_floating_window([ $args ])
361
362 Thin wrapper around open_window which sets window_type to
363 C<_NET_WM_WINDOW_TYPE_UTILITY> to make the window floating.
364
365 The arguments are the same as those of C<open_window>.
366
367 =cut
368 sub open_floating_window {
369     my %args = @_ == 1 ? %{$_[0]} : @_;
370
371     $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY');
372
373     return open_window(\%args);
374 }
375
376 sub open_empty_con {
377     my ($i3) = @_;
378
379     my $reply = $i3->command('open')->recv;
380     return $reply->[0]->{id};
381 }
382
383 =head2 get_workspace_names()
384
385 Returns an arrayref containing the name of every workspace (regardless of its
386 output) which currently exists.
387
388   my $workspace_names = get_workspace_names;
389   is(scalar @$workspace_names, 3, 'three workspaces exist currently');
390
391 =cut
392 sub get_workspace_names {
393     my $i3 = i3(get_socket_path());
394     my $tree = $i3->get_tree->recv;
395     my @outputs = @{$tree->{nodes}};
396     my @cons;
397     for my $output (@outputs) {
398         next if $output->{name} eq '__i3';
399         # get the first CT_CON of each output
400         my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
401         @cons = (@cons, @{$content->{nodes}});
402     }
403     [ map { $_->{name} } @cons ]
404 }
405
406 =head2 get_output_for_workspace()
407
408 Returns the name of the output on which this workspace resides
409
410   cmd 'focus output fake-1';
411   cmd 'workspace 1';
412   is(get_output_for_workspace('1', 'fake-0', 'Workspace 1 in output fake-0');
413
414 =cut
415 sub get_output_for_workspace {
416     my $ws_name = shift @_;
417     my $i3 = i3(get_socket_path());
418     my $tree = $i3->get_tree->recv;
419     my @outputs = @{$tree->{nodes}};
420
421     foreach (grep { not $_->{name} =~ /^__/ } @outputs) {
422         my $output = $_->{name};
423         foreach (grep { $_->{name} =~ "content" } @{$_->{nodes}}) {
424             return $output if $_->{nodes}[0]->{name} =~ $ws_name;
425         }
426     }
427 }
428
429 =head2 get_unused_workspace
430
431 Returns a workspace name which has not yet been used. See also
432 C<fresh_workspace> which directly switches to an unused workspace.
433
434   my $ws = get_unused_workspace;
435   cmd "workspace $ws";
436
437 =cut
438 sub get_unused_workspace {
439     my @names = get_workspace_names();
440     my $tmp;
441     do { $tmp = tmpnam() } while ((scalar grep { $_ eq $tmp } @names) > 0);
442     $tmp
443 }
444
445 =head2 fresh_workspace([ $args ])
446
447 Switches to an unused workspace and returns the name of that workspace.
448
449 Optionally switches to the specified output first.
450
451     my $ws = fresh_workspace;
452
453     # Get a fresh workspace on the second output.
454     my $ws = fresh_workspace(output => 1);
455
456 =cut
457 sub fresh_workspace {
458     my %args = @_;
459     if (exists($args{output})) {
460         my $i3 = i3(get_socket_path());
461         my $tree = $i3->get_tree->recv;
462         my $output = first { $_->{name} eq "fake-$args{output}" }
463                         @{$tree->{nodes}};
464         die "BUG: Could not find output $args{output}" unless defined($output);
465         # Get the focused workspace on that output and switch to it.
466         my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
467         my $focused = $content->{focus}->[0];
468         my $workspace = first { $_->{id} == $focused } @{$content->{nodes}};
469         $workspace = $workspace->{name};
470         cmd("workspace $workspace");
471     }
472
473     my $unused = get_unused_workspace;
474     cmd("workspace $unused");
475     $unused
476 }
477
478 =head2 get_ws($workspace)
479
480 Returns the container (from the i3 layout tree) which represents C<$workspace>.
481
482   my $ws = fresh_workspace;
483   my $ws_con = get_ws($ws);
484   ok(!$ws_con->{urgent}, 'fresh workspace not marked urgent');
485
486 Here is an example which counts the number of urgent containers recursively,
487 starting from the workspace container:
488
489   sub count_urgent {
490       my ($con) = @_;
491
492       my @children = (@{$con->{nodes}}, @{$con->{floating_nodes}});
493       my $urgent = grep { $_->{urgent} } @children;
494       $urgent += count_urgent($_) for @children;
495       return $urgent;
496   }
497   my $urgent = count_urgent(get_ws($ws));
498   is($urgent, 3, "three urgent windows on workspace $ws");
499
500
501 =cut
502 sub get_ws {
503     my ($name) = @_;
504     my $i3 = i3(get_socket_path());
505     my $tree = $i3->get_tree->recv;
506
507     my @outputs = @{$tree->{nodes}};
508     my @workspaces;
509     for my $output (@outputs) {
510         # get the first CT_CON of each output
511         my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
512         @workspaces = (@workspaces, @{$content->{nodes}});
513     }
514
515     # as there can only be one workspace with this name, we can safely
516     # return the first entry
517     return first { $_->{name} eq $name } @workspaces;
518 }
519
520 =head2 get_ws_content($workspace)
521
522 Returns the content (== tree, starting from the node of a workspace)
523 of a workspace. If called in array context, also includes the focus
524 stack of the workspace.
525
526   my $nodes = get_ws_content($ws);
527   is(scalar @$nodes, 4, 'there are four containers at workspace-level');
528
529 Or, in array context:
530
531   my $window = open_window;
532   my ($nodes, $focus) = get_ws_content($ws);
533   is($focus->[0], $window->id, 'newly opened window focused');
534
535 Note that this function does not do recursion for you! It only returns the
536 containers B<on workspace level>. If you want to work with all containers (even
537 nested ones) on a workspace, you have to use recursion:
538
539   # NB: This function does not count floating windows
540   sub count_urgent {
541       my ($nodes) = @_;
542
543       my $urgent = 0;
544       for my $con (@$nodes) {
545           $urgent++ if $con->{urgent};
546           $urgent += count_urgent($con->{nodes});
547       }
548
549       return $urgent;
550   }
551   my $nodes = get_ws_content($ws);
552   my $urgent = count_urgent($nodes);
553   is($urgent, 3, "three urgent windows on workspace $ws");
554
555 If you also want to deal with floating windows, you have to use C<get_ws>
556 instead and access C<< ->{nodes} >> and C<< ->{floating_nodes} >> on your own.
557
558 =cut
559 sub get_ws_content {
560     my ($name) = @_;
561     my $con = get_ws($name);
562     return wantarray ? ($con->{nodes}, $con->{focus}) : $con->{nodes};
563 }
564
565 =head2 get_focused($workspace)
566
567 Returns the container ID of the currently focused container on C<$workspace>.
568
569 Note that the container ID is B<not> the X11 window ID, so comparing the result
570 of C<get_focused> with a window's C<< ->{id} >> property does B<not> work.
571
572   my $ws = fresh_workspace;
573   my $first_window = open_window;
574   my $first_id = get_focused();
575
576   my $second_window = open_window;
577   my $second_id = get_focused();
578
579   cmd 'focus left';
580
581   is(get_focused($ws), $first_id, 'second window focused');
582
583 =cut
584 sub get_focused {
585     my ($ws) = @_;
586     my $con = get_ws($ws);
587
588     my @focused = @{$con->{focus}};
589     my $lf;
590     while (@focused > 0) {
591         $lf = $focused[0];
592         last unless defined($con->{focus});
593         @focused = @{$con->{focus}};
594         my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
595         $con = $cons[0];
596     }
597
598     return $lf;
599 }
600
601 =head2 get_dock_clients([ $dockarea ])
602
603 Returns an array of all dock containers in C<$dockarea> (one of "top" or
604 "bottom"). If C<$dockarea> is not specified, returns an array of all dock
605 containers in any dockarea.
606
607   my @docked = get_dock_clients;
608   is(scalar @docked, 0, 'no dock clients yet');
609
610 =cut
611 sub get_dock_clients {
612     my $which = shift;
613
614     my $tree = i3(get_socket_path())->get_tree->recv;
615     my @outputs = @{$tree->{nodes}};
616     # Children of all dockareas
617     my @docked;
618     for my $output (@outputs) {
619         if (!defined($which)) {
620             @docked = (@docked, map { @{$_->{nodes}} }
621                                 grep { $_->{type} eq 'dockarea' }
622                                 @{$output->{nodes}});
623         } elsif ($which eq 'top') {
624             my $first = first { $_->{type} eq 'dockarea' } @{$output->{nodes}};
625             @docked = (@docked, @{$first->{nodes}}) if defined($first);
626         } elsif ($which eq 'bottom') {
627             my @matching = grep { $_->{type} eq 'dockarea' } @{$output->{nodes}};
628             my $last = $matching[-1];
629             @docked = (@docked, @{$last->{nodes}}) if defined($last);
630         }
631     }
632     return @docked;
633 }
634
635 =head2 cmd($command)
636
637 Sends the specified command to i3 and returns the output.
638
639   my $ws = unused_workspace;
640   cmd "workspace $ws";
641   cmd 'focus right';
642
643 =cut
644 sub cmd {
645     i3(get_socket_path())->command(@_)->recv
646 }
647
648 =head2 workspace_exists($workspace)
649
650 Returns true if C<$workspace> is the name of an existing workspace.
651
652   my $old_ws = focused_ws;
653   # switch away from where we currently are
654   fresh_workspace;
655
656   ok(workspace_exists($old_ws), 'old workspace still exists');
657
658 =cut
659 sub workspace_exists {
660     my ($name) = @_;
661     (scalar grep { $_ eq $name } @{get_workspace_names()}) > 0;
662 }
663
664 =head2 focused_ws
665
666 Returns the name of the currently focused workspace.
667
668   my $ws = focused_ws;
669   is($ws, '1', 'i3 starts on workspace 1');
670
671 =cut
672 sub focused_ws {
673     my $i3 = i3(get_socket_path());
674     my $tree = $i3->get_tree->recv;
675     my $focused = $tree->{focus}->[0];
676     my $output = first { $_->{id} == $focused } @{$tree->{nodes}};
677     my $content = first { $_->{type} eq 'con' } @{$output->{nodes}};
678     my $first = first { $_->{fullscreen_mode} == 1 } @{$content->{nodes}};
679     return $first->{name}
680 }
681
682 =head2 sync_with_i3([ $args ])
683
684 Sends an I3_SYNC ClientMessage with a random value to the root window.
685 i3 will reply with the same value, but, due to the order of events it
686 processes, only after all other events are done.
687
688 This can be used to ensure the results of a cmd 'focus left' are pushed to
689 X11 and that C<< $x->input_focus >> returns the correct value afterwards.
690
691 See also L<https://build.i3wm.org/docs/testsuite.html> for a longer explanation.
692
693   my $window = open_window;
694   $window->add_hint('urgency');
695   # Ensure i3 picked up the change
696   sync_with_i3;
697
698 The only time when you need to use the C<no_cache> argument is when you just
699 killed your own X11 connection:
700
701   cmd 'kill client';
702   # We need to re-establish the X11 connection which we just killed :).
703   $x = i3test::X11->new;
704   sync_with_i3(no_cache => 1);
705
706 =cut
707 sub sync_with_i3 {
708     my %args = @_ == 1 ? %{$_[0]} : @_;
709
710     # Since we need a (mapped) window for receiving a ClientMessage, we create
711     # one on the first call of sync_with_i3. It will be re-used in all
712     # subsequent calls.
713     if (!exists($args{window_id}) &&
714         (!defined($_sync_window) || exists($args{no_cache}))) {
715         $_sync_window = open_window(
716             rect => [ -15, -15, 10, 10 ],
717             override_redirect => 1,
718             dont_map => 1,
719         );
720     }
721
722     my $window_id = delete $args{window_id};
723     $window_id //= $_sync_window->id;
724
725     my $root = $x->get_root_window();
726     # Generate a random number to identify this particular ClientMessage.
727     my $myrnd = int(rand(255)) + 1;
728
729     # Generate a ClientMessage, see xcb_client_message_t
730     my $msg = pack "CCSLLLLLLL",
731          CLIENT_MESSAGE, # response_type
732          32,     # format
733          0,      # sequence
734          $root,  # destination window
735          $x->atom(name => 'I3_SYNC')->id,
736
737          $window_id,    # data[0]: our own window id
738          $myrnd, # data[1]: a random value to identify the request
739          0,
740          0,
741          0;
742
743     # Send it to the root window -- since i3 uses the SubstructureRedirect
744     # event mask, it will get the ClientMessage.
745     $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
746
747     return $myrnd if $args{dont_wait_for_event};
748
749     # now wait until the reply is here
750     return wait_for_event 4, sub {
751         my ($event) = @_;
752         # TODO: const
753         return 0 unless $event->{response_type} == 161;
754
755         my ($win, $rnd) = unpack "LL", $event->{data};
756         return ($rnd == $myrnd);
757     };
758 }
759
760 =head2 exit_gracefully($pid, [ $socketpath ])
761
762 Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails.
763
764 If C<$socketpath> is not specified, C<get_socket_path()> will be called.
765
766 You only need to use this function if you have launched i3 on your own with
767 C<launch_with_config>. Otherwise, it will be automatically called when the
768 testcase ends.
769
770   use i3test i3_autostart => 0;
771   my $pid = launch_with_config($config);
772   # …
773   exit_gracefully($pid);
774
775 =cut
776 sub exit_gracefully {
777     my ($pid, $socketpath) = @_;
778     $socketpath ||= get_socket_path();
779
780     my $exited = 0;
781     eval {
782         say "Exiting i3 cleanly...";
783         i3($socketpath)->command('exit')->recv;
784         $exited = 1;
785     };
786
787     if (!$exited) {
788         kill(9, $pid)
789             or $tester->BAIL_OUT("could not kill i3: $!");
790     }
791
792     if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
793         unlink($socketpath);
794     }
795
796     waitpid $pid, 0;
797     undef $i3_pid;
798 }
799
800 =head2 exit_forcefully($pid, [ $signal ])
801
802 Tries to exit i3 forcefully by sending a signal (defaults to SIGTERM).
803
804 You only need to use this function if you want to test signal handling
805 (in which case you must have launched i3 on your own with
806 C<launch_with_config>).
807
808   use i3test i3_autostart => 0;
809   my $pid = launch_with_config($config);
810   # …
811   exit_forcefully($pid);
812
813 =cut
814 sub exit_forcefully {
815     my ($pid, $signal) = @_;
816     $signal ||= 'TERM';
817
818     # Send the given signal to the i3 instance and wait for up to 10s
819     # for it to terminate.
820     kill($signal, $pid)
821         or $tester->BAIL_OUT("could not kill i3: $!");
822     my $status;
823     my $timeout = 10;
824     do {
825         $status = waitpid $pid, WNOHANG;
826
827         if ($status <= 0) {
828             sleep(1);
829             $timeout--;
830         }
831     } while ($status <= 0 && $timeout > 0);
832
833     if ($status <= 0) {
834         kill('KILL', $pid)
835             or $tester->BAIL_OUT("could not kill i3: $!");
836         waitpid $pid, 0;
837     }
838     undef $i3_pid;
839 }
840
841 =head2 get_socket_path([ $cache ])
842
843 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
844 window. After the first call, this function will return a cached version of the
845 socket path unless you specify a false value for C<$cache>.
846
847   my $i3 = i3(get_socket_path());
848   $i3->command('nop test example')->recv;
849
850 To avoid caching:
851
852   my $i3 = i3(get_socket_path(0));
853
854 =cut
855 sub get_socket_path {
856     my ($cache) = @_;
857     $cache //= 1;
858
859     if ($cache && defined($_cached_socket_path)) {
860         return $_cached_socket_path;
861     }
862     my $socketpath = i3test::Util::get_socket_path($x);
863     $_cached_socket_path = $socketpath;
864     return $socketpath;
865 }
866
867 =head2 launch_with_config($config, [ $args ])
868
869 Launches a new i3 process with C<$config> as configuration file. Useful for
870 tests which test specific config file directives.
871
872   use i3test i3_autostart => 0;
873
874   my $config = <<EOT;
875   # i3 config file (v4)
876   for_window [class="borderless"] border none
877   for_window [title="special borderless title"] border none
878   EOT
879
880   my $pid = launch_with_config($config);
881
882   # …
883
884   exit_gracefully($pid);
885
886 =cut
887 sub launch_with_config {
888     my ($config, %args) = @_;
889
890     $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
891
892     $args{dont_create_temp_dir} //= 0;
893     $args{validate_config} //= 0;
894
895     my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
896
897     say $fh "ipc-socket $tmp_socket_path"
898         unless $args{dont_add_socket_path};
899
900     if ($config ne '-default') {
901         print $fh $config;
902     } else {
903         open(my $conf_fh, '<', '@abs_top_srcdir@/testcases/i3-test.config')
904             or $tester->BAIL_OUT("could not open default config: $!");
905         local $/;
906         say $fh scalar <$conf_fh>;
907     }
908
909     close($fh);
910
911     my $cv = AnyEvent->condvar;
912     $i3_pid = activate_i3(
913         unix_socket_path => "$tmp_socket_path-activation",
914         display => $ENV{DISPLAY},
915         configfile => $tmpfile,
916         outdir => $ENV{OUTDIR},
917         testname => $ENV{TESTNAME},
918         valgrind => $ENV{VALGRIND},
919         strace => $ENV{STRACE},
920         xtrace => $ENV{XTRACE},
921         restart => $ENV{RESTART},
922         cv => $cv,
923         dont_create_temp_dir => $args{dont_create_temp_dir},
924         validate_config => $args{validate_config},
925         inject_randr15 => $args{inject_randr15},
926         inject_randr15_outputinfo => $args{inject_randr15_outputinfo},
927     );
928
929     # If we called i3 with -C, we wait for it to exit and then return as
930     # there's nothing else we need to do.
931     if ($args{validate_config}) {
932         $cv->recv;
933         waitpid $i3_pid, 0;
934
935         # We need this since exit_gracefully will not be called in this case.
936         undef $i3_pid;
937
938         return ${^CHILD_ERROR_NATIVE};
939     }
940
941     # force update of the cached socket path in lib/i3test
942     # as soon as i3 has started
943     $cv->cb(sub { get_socket_path(0) });
944
945     return $cv if $args{dont_block};
946
947     # blockingly wait until i3 is ready
948     $cv->recv;
949
950     return $i3_pid;
951 }
952
953 =head2 get_i3_log
954
955 Returns the content of the log file for the current test.
956
957 =cut
958 sub get_i3_log {
959     my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}";
960     return slurp($logfile);
961 }
962
963 =head2 kill_all_windows
964
965 Kills all windows to clean up between tests.
966
967 =cut
968 sub kill_all_windows {
969     # Sync in case not all windows are managed by i3 just yet.
970     sync_with_i3;
971     cmd '[title=".*"] kill';
972 }
973
974 =head2 events_for($subscribecb, [ $rettype ], [ $eventcbs ])
975
976 Helper function which returns an array containing all events of type $rettype
977 which were generated by i3 while $subscribecb was running.
978
979 Set $eventcbs to subscribe to multiple event types and/or perform your own event
980 aggregation.
981
982 =cut
983 sub events_for {
984     my ($subscribecb, $rettype, $eventcbs) = @_;
985
986     my @events;
987     $eventcbs //= {};
988     if (defined($rettype)) {
989         $eventcbs->{$rettype} = sub { push @events, shift };
990     }
991     my $subscribed = AnyEvent->condvar;
992     my $flushed = AnyEvent->condvar;
993     $eventcbs->{tick} = sub {
994         my ($event) = @_;
995         if ($event->{first}) {
996             $subscribed->send($event);
997         } else {
998             $flushed->send($event);
999         }
1000     };
1001     my $i3 = i3(get_socket_path(0));
1002     $i3->connect->recv;
1003     $i3->subscribe($eventcbs)->recv;
1004     $subscribed->recv;
1005     # Subscription established, run the callback.
1006     $subscribecb->();
1007     # Now generate a tick event, which we know we’ll receive (and at which point
1008     # all other events have been received).
1009     my $nonce = int(rand(255)) + 1;
1010     $i3->send_tick($nonce);
1011
1012     my $tick = $flushed->recv;
1013     $tester->is_eq($tick->{payload}, $nonce, 'tick nonce received');
1014     return @events;
1015 }
1016
1017 =head2 listen_for_binding($cb)
1018
1019 Helper function to evaluate whether sending KeyPress/KeyRelease events via XTEST
1020 triggers an i3 key binding or not. Expects key bindings to be configured in the
1021 form “bindsym <binding> nop <binding>”, e.g.  “bindsym Mod4+Return nop
1022 Mod4+Return”.
1023
1024   is(listen_for_binding(
1025       sub {
1026           xtest_key_press(133); # Super_L
1027           xtest_key_press(36); # Return
1028           xtest_key_release(36); # Return
1029           xtest_key_release(133); # Super_L
1030           xtest_sync_with_i3;
1031       },
1032       ),
1033      'Mod4+Return',
1034      'triggered the "Mod4+Return" keybinding');
1035
1036 =cut
1037
1038 sub listen_for_binding {
1039     my ($cb) = @_;
1040     my $triggered = AnyEvent->condvar;
1041     my @events = events_for(
1042         $cb,
1043         'binding');
1044
1045     $tester->is_eq(scalar @events, 1, 'Received precisely one event');
1046     $tester->is_eq($events[0]->{change}, 'run', 'change is "run"');
1047     # We look at the command (which is “nop <binding>”) because that is easier
1048     # than re-assembling the string representation of $event->{binding}.
1049     my $command = $events[0]->{binding}->{command};
1050     $command =~ s/^nop //g;
1051     return $command;
1052 }
1053
1054 =head2 is_net_wm_state_focused
1055
1056 Returns true if the given window has the _NET_WM_STATE_FOCUSED atom.
1057
1058     ok(is_net_wm_state_focused($window), '_NET_WM_STATE_FOCUSED set');
1059
1060 =cut
1061 sub is_net_wm_state_focused {
1062     my ($window) = @_;
1063
1064     sync_with_i3;
1065     my $atom = $x->atom(name => '_NET_WM_STATE_FOCUSED');
1066     my $cookie = $x->get_property(
1067         0,
1068         $window->{id},
1069         $x->atom(name => '_NET_WM_STATE')->id,
1070         GET_PROPERTY_TYPE_ANY,
1071         0,
1072         4096
1073     );
1074
1075     my $reply = $x->get_property_reply($cookie->{sequence});
1076     my $len = $reply->{length};
1077     return 0 if $len == 0;
1078
1079     my @atoms = unpack("L$len", $reply->{value});
1080     for (my $i = 0; $i < $len; $i++) {
1081         return 1 if $atoms[$i] == $atom->id;
1082     }
1083
1084     return 0;
1085 }
1086
1087
1088 =head1 AUTHOR
1089
1090 Michael Stapelberg <michael@i3wm.org>
1091
1092 =cut
1093
1094 package i3test::X11;
1095 use parent 'X11::XCB::Connection';
1096
1097 sub input_focus {
1098     my $self = shift;
1099     i3test::sync_with_i3();
1100
1101     return $self->SUPER::input_focus(@_);
1102 }
1103
1104 1