]> git.sur5r.net Git - i3/i3/blob - testcases/lib/i3test.pm.in
testcases/lib: Add inject_randr15_outputinfo argument
[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 );
51
52 =head1 NAME
53
54 i3test - Testcase setup module
55
56 =encoding utf-8
57
58 =head1 SYNOPSIS
59
60   use i3test;
61
62   my $ws = fresh_workspace;
63   is_num_children($ws, 0, 'no containers on this workspace yet');
64   cmd 'open';
65   is_num_children($ws, 1, 'one container after "open"');
66
67   done_testing;
68
69 =head1 DESCRIPTION
70
71 This module is used in every i3 testcase and takes care of automatically
72 starting i3 before any test instructions run. It also saves you typing of lots
73 of boilerplate in every test file.
74
75
76 i3test automatically "use"s C<Test::More>, C<Data::Dumper>, C<AnyEvent::I3>,
77 C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
78 to you in your testcase.
79
80 See also C<i3test::Test> (L<http://build.i3wm.org/docs/lib-i3test-test.html>)
81 which provides additional test instructions (like C<ok> or C<is>).
82
83 =cut
84
85 my $tester = Test::Builder->new();
86 my $_cached_socket_path = undef;
87 my $_sync_window = undef;
88 my $tmp_socket_path = undef;
89
90 our $x;
91
92 BEGIN {
93     my $window_count = 0;
94     sub counter_window {
95         return $window_count++;
96     }
97 }
98
99 my $i3_pid;
100 my $i3_autostart;
101
102 END {
103
104     # testcases which start i3 manually should always call exit_gracefully
105     # on their own. Let’s see, whether they really did.
106     if (! $i3_autostart) {
107         return unless $i3_pid;
108
109         $tester->ok(undef, 'testcase called exit_gracefully()');
110     }
111
112     # don't trigger SIGCHLD handler
113     local $SIG{CHLD};
114
115     # From perldoc -v '$?':
116     # Inside an "END" subroutine $? contains the value
117     # that is going to be given to "exit()".
118     #
119     # Since waitpid sets $?, we need to localize it,
120     # otherwise TAP would be misinterpreted our return status
121     local $?;
122
123     # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
124     # files are not written)
125     if ($ENV{COVERAGE} || $ENV{VALGRIND}) {
126         exit_gracefully($i3_pid, "/tmp/nested-$ENV{DISPLAY}");
127
128     } else {
129         kill(9, $i3_pid)
130             or $tester->BAIL_OUT("could not kill i3");
131
132         waitpid $i3_pid, 0;
133     }
134 }
135
136 sub import {
137     my ($class, %args) = @_;
138     my $pkg = caller;
139
140     $i3_autostart = delete($args{i3_autostart}) // 1;
141
142     my $cv = launch_with_config('-default', dont_block => 1)
143         if $i3_autostart;
144
145     my $test_more_args = '';
146     $test_more_args = join(' ', 'qw(', %args, ')') if keys %args;
147     local $@;
148     eval << "__";
149 package $pkg;
150 use Test::More $test_more_args;
151 use Data::Dumper;
152 use AnyEvent::I3;
153 use Time::HiRes qw(sleep);
154 use i3test::Test;
155 __
156     $tester->BAIL_OUT("$@") if $@;
157     feature->import(":5.10");
158     strict->import;
159     warnings->import;
160
161     $x ||= i3test::X11->new;
162     # set the pointer to a predictable position in case a previous test has
163     # disturbed it
164     $x->root->warp_pointer(0, 0);
165     $cv->recv if $i3_autostart;
166
167     @_ = ($class);
168     goto \&Exporter::import;
169 }
170
171 =head1 EXPORT
172
173 =head2 wait_for_event($timeout, $callback)
174
175 Waits for the next event and calls the given callback for every event to
176 determine if this is the event we are waiting for.
177
178 Can be used to wait until a window is mapped, until a ClientMessage is
179 received, etc.
180
181   wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
182
183 =cut
184 sub wait_for_event {
185     my ($timeout, $cb) = @_;
186
187     my $cv = AE::cv;
188
189     $x->flush;
190
191     # unfortunately, there is no constant for this
192     my $ae_read = 0;
193
194     my $guard = AE::io $x->get_file_descriptor, $ae_read, sub {
195         while (defined(my $event = $x->poll_for_event)) {
196             if ($cb->($event)) {
197                 $cv->send(1);
198                 last;
199             }
200         }
201     };
202
203     # Trigger timeout after $timeout seconds (can be fractional)
204     my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) };
205
206     my $result = $cv->recv;
207     undef $t;
208     undef $guard;
209     return $result;
210 }
211
212 =head2 wait_for_map($window)
213
214 Thin wrapper around wait_for_event which waits for MAP_NOTIFY.
215 Make sure to include 'structure_notify' in the window’s event_mask attribute.
216
217 This function is called by C<open_window>, so in most cases, you don’t need to
218 call it on your own. If you need special setup of the window before mapping,
219 you might have to map it on your own and use this function:
220
221   my $window = open_window(dont_map => 1);
222   # Do something special with the window first
223   # …
224
225   # Now map it and wait until it’s been mapped
226   $window->map;
227   wait_for_map($window);
228
229 =cut
230 sub wait_for_map {
231     my ($win) = @_;
232     my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
233     wait_for_event 4, sub {
234         $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id
235     };
236 }
237
238 =head2 wait_for_unmap($window)
239
240 Wrapper around C<wait_for_event> which waits for UNMAP_NOTIFY. Also calls
241 C<sync_with_i3> to make sure i3 also picked up and processed the UnmapNotify
242 event.
243
244   my $ws = fresh_workspace;
245   my $window = open_window;
246   is_num_children($ws, 1, 'one window on workspace');
247   $window->unmap;
248   wait_for_unmap;
249   is_num_children($ws, 0, 'no more windows on this workspace');
250
251 =cut
252 sub wait_for_unmap {
253     my ($win) = @_;
254     # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
255     wait_for_event 4, sub {
256         $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id
257     };
258     sync_with_i3();
259 }
260
261 =head2 open_window([ $args ])
262
263 Opens a new window (see C<X11::XCB::Window>), maps it, waits until it got mapped
264 and synchronizes with i3.
265
266 The following arguments can be passed:
267
268 =over 4
269
270 =item class
271
272 The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with
273 the WM_CLASS!
274
275 =item rect
276
277 An arrayref with 4 members specifying the initial geometry (position and size)
278 of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100
279 with width=70 and height=50.
280
281 Note that this is entirely irrelevant for tiling windows.
282
283 =item background_color
284
285 The background pixel color of the window, formatted as "#rrggbb", like HTML
286 color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually
287 watching the testcases.
288
289 =item event_mask
290
291 An arrayref containing strings which describe the X11 event mask we use for that
292 window. The default is C<< [ 'structure_notify' ] >>.
293
294 =item name
295
296 The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window
297 n" with n being replaced by a counter to keep windows apart.
298
299 =item dont_map
300
301 Set to a true value to avoid mapping the window (making it visible).
302
303 =item before_map
304
305 A coderef which is called before the window is mapped (unless C<dont_map> is
306 true). The freshly created C<$window> is passed as C<$_> and as the first
307 argument.
308
309 =back
310
311 The default values are equivalent to this call:
312
313   open_window(
314     class => WINDOW_CLASS_INPUT_OUTPUT
315     rect => [ 0, 0, 30, 30 ]
316     background_color => '#c0c0c0'
317     event_mask => [ 'structure_notify' ]
318     name => 'Window <n>'
319   );
320
321 Usually, though, calls are simpler:
322
323   my $top_window = open_window;
324
325 To identify the resulting window object in i3 commands, use the id property:
326
327   my $top_window = open_window;
328   cmd '[id="' . $top_window->id . '"] kill';
329
330 =cut
331 sub open_window {
332     my %args = @_ == 1 ? %{$_[0]} : @_;
333
334     my $dont_map = delete $args{dont_map};
335     my $before_map = delete $args{before_map};
336
337     $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
338     $args{rect} //= [ 0, 0, 30, 30 ];
339     $args{background_color} //= '#c0c0c0';
340     $args{event_mask} //= [ 'structure_notify' ];
341     $args{name} //= 'Window ' . counter_window();
342
343     my $window = $x->root->create_child(%args);
344     $window->add_hint('input');
345
346     if ($before_map) {
347         # TODO: investigate why _create is not needed
348         $window->_create;
349         $before_map->($window) for $window;
350     }
351
352     return $window if $dont_map;
353
354     $window->map;
355     wait_for_map($window);
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<http://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         );
695     }
696
697     my $window_id = delete $args{window_id};
698     $window_id //= $_sync_window->id;
699
700     my $root = $x->get_root_window();
701     # Generate a random number to identify this particular ClientMessage.
702     my $myrnd = int(rand(255)) + 1;
703
704     # Generate a ClientMessage, see xcb_client_message_t
705     my $msg = pack "CCSLLLLLLL",
706          CLIENT_MESSAGE, # response_type
707          32,     # format
708          0,      # sequence
709          $root,  # destination window
710          $x->atom(name => 'I3_SYNC')->id,
711
712          $window_id,    # data[0]: our own window id
713          $myrnd, # data[1]: a random value to identify the request
714          0,
715          0,
716          0;
717
718     # Send it to the root window -- since i3 uses the SubstructureRedirect
719     # event mask, it will get the ClientMessage.
720     $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
721
722     return $myrnd if $args{dont_wait_for_event};
723
724     # now wait until the reply is here
725     return wait_for_event 4, sub {
726         my ($event) = @_;
727         # TODO: const
728         return 0 unless $event->{response_type} == 161;
729
730         my ($win, $rnd) = unpack "LL", $event->{data};
731         return ($rnd == $myrnd);
732     };
733 }
734
735 =head2 exit_gracefully($pid, [ $socketpath ])
736
737 Tries to exit i3 gracefully (with the 'exit' cmd) or kills the PID if that fails.
738
739 If C<$socketpath> is not specified, C<get_socket_path()> will be called.
740
741 You only need to use this function if you have launched i3 on your own with
742 C<launch_with_config>. Otherwise, it will be automatically called when the
743 testcase ends.
744
745   use i3test i3_autostart => 0;
746   my $pid = launch_with_config($config);
747   # …
748   exit_gracefully($pid);
749
750 =cut
751 sub exit_gracefully {
752     my ($pid, $socketpath) = @_;
753     $socketpath ||= get_socket_path();
754
755     my $exited = 0;
756     eval {
757         say "Exiting i3 cleanly...";
758         i3($socketpath)->command('exit')->recv;
759         $exited = 1;
760     };
761
762     if (!$exited) {
763         kill(9, $pid)
764             or $tester->BAIL_OUT("could not kill i3");
765     }
766
767     if ($socketpath =~ m,^/tmp/i3-test-socket-,) {
768         unlink($socketpath);
769     }
770
771     waitpid $pid, 0;
772     undef $i3_pid;
773 }
774
775 =head2 get_socket_path([ $cache ])
776
777 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
778 window. After the first call, this function will return a cached version of the
779 socket path unless you specify a false value for C<$cache>.
780
781   my $i3 = i3(get_socket_path());
782   $i3->command('nop test example')->recv;
783
784 To avoid caching:
785
786   my $i3 = i3(get_socket_path(0));
787
788 =cut
789 sub get_socket_path {
790     my ($cache) = @_;
791     $cache //= 1;
792
793     if ($cache && defined($_cached_socket_path)) {
794         return $_cached_socket_path;
795     }
796
797     my $atom = $x->atom(name => 'I3_SOCKET_PATH');
798     my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256);
799     my $reply = $x->get_property_reply($cookie->{sequence});
800     my $socketpath = $reply->{value};
801     if ($socketpath eq "/tmp/nested-$ENV{DISPLAY}") {
802         $socketpath .= '-activation';
803     }
804     $_cached_socket_path = $socketpath;
805     return $socketpath;
806 }
807
808 =head2 launch_with_config($config, [ $args ])
809
810 Launches a new i3 process with C<$config> as configuration file. Useful for
811 tests which test specific config file directives.
812
813   use i3test i3_autostart => 0;
814
815   my $config = <<EOT;
816   # i3 config file (v4)
817   for_window [class="borderless"] border none
818   for_window [title="special borderless title"] border none
819   EOT
820
821   my $pid = launch_with_config($config);
822
823   # …
824
825   exit_gracefully($pid);
826
827 =cut
828 sub launch_with_config {
829     my ($config, %args) = @_;
830
831     $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
832
833     $args{dont_create_temp_dir} //= 0;
834     $args{validate_config} //= 0;
835
836     my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
837
838     if ($config ne '-default') {
839         say $fh $config;
840     } else {
841         open(my $conf_fh, '<', '@abs_top_srcdir@/testcases/i3-test.config')
842             or $tester->BAIL_OUT("could not open default config: $!");
843         local $/;
844         say $fh scalar <$conf_fh>;
845     }
846
847     say $fh "ipc-socket $tmp_socket_path"
848         unless $args{dont_add_socket_path};
849
850     close($fh);
851
852     my $cv = AnyEvent->condvar;
853     $i3_pid = activate_i3(
854         unix_socket_path => "$tmp_socket_path-activation",
855         display => $ENV{DISPLAY},
856         configfile => $tmpfile,
857         outdir => $ENV{OUTDIR},
858         testname => $ENV{TESTNAME},
859         valgrind => $ENV{VALGRIND},
860         strace => $ENV{STRACE},
861         xtrace => $ENV{XTRACE},
862         restart => $ENV{RESTART},
863         cv => $cv,
864         dont_create_temp_dir => $args{dont_create_temp_dir},
865         validate_config => $args{validate_config},
866         inject_randr15 => $args{inject_randr15},
867         inject_randr15_outputinfo => $args{inject_randr15_outputinfo},
868     );
869
870     # If we called i3 with -C, we wait for it to exit and then return as
871     # there's nothing else we need to do.
872     if ($args{validate_config}) {
873         $cv->recv;
874         waitpid $i3_pid, 0;
875
876         # We need this since exit_gracefully will not be called in this case.
877         undef $i3_pid;
878
879         return ${^CHILD_ERROR_NATIVE};
880     }
881
882     # force update of the cached socket path in lib/i3test
883     # as soon as i3 has started
884     $cv->cb(sub { get_socket_path(0) });
885
886     return $cv if $args{dont_block};
887
888     # blockingly wait until i3 is ready
889     $cv->recv;
890
891     return $i3_pid;
892 }
893
894 =head2 get_i3_log
895
896 Returns the content of the log file for the current test.
897
898 =cut
899 sub get_i3_log {
900     my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}";
901     return slurp($logfile);
902 }
903
904 =head2 kill_all_windows
905
906 Kills all windows to clean up between tests.
907
908 =cut
909 sub kill_all_windows {
910     # Sync in case not all windows are managed by i3 just yet.
911     sync_with_i3;
912     cmd '[title=".*"] kill';
913 }
914
915 =head1 AUTHOR
916
917 Michael Stapelberg <michael@i3wm.org>
918
919 =cut
920
921 package i3test::X11;
922 use parent 'X11::XCB::Connection';
923
924 sub input_focus {
925     my $self = shift;
926     i3test::sync_with_i3();
927
928     return $self->SUPER::input_focus(@_);
929 }
930
931 1