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