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