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