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