git.sur5r.net Git - i3/i3/blob - 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 );
  55
  56 =head1 NAME
  57
  58 i3test - Testcase setup module
  59
  60 =encoding utf-8
  61
  62 =head1 SYNOPSIS
  63
  64   use i3test;
  65
  66   my $ws = fresh_workspace;
  67   is_num_children($ws, 0, 'no containers on this workspace yet');
  68   cmd 'open';
  69   is_num_children($ws, 1, 'one container after "open"');
  70
  71   done_testing;
  72
  73 =head1 DESCRIPTION
  74
  75 This module is used in every i3 testcase and takes care of automatically
  76 starting i3 before any test instructions run. It also saves you typing of lots
  77 of boilerplate in every test file.
  78
  79
  80 i3test automatically "use"s C<Test::More>, C<Data::Dumper>, C<AnyEvent::I3>,
  81 C<Time::HiRes>’s C<sleep> and C<i3test::Test> so that all of them are available
  82 to you in your testcase.
  83
  84 See also C<i3test::Test> (L<https://build.i3wm.org/docs/lib-i3test-test.html>)
  85 which provides additional test instructions (like C<ok> or C<is>).
  86
  87 =cut
  88
  89 my $tester = Test::Builder->new();
  90 my $_cached_socket_path = undef;
  91 my $_sync_window = undef;
  92 my $tmp_socket_path = undef;
  93
  94 our $x;
  95
  96 BEGIN {
  97     my $window_count = 0;
  98     sub counter_window {
  99         return $window_count++;
 100     }
 101 }
 102
 103 my $i3_pid;
 104 my $i3_autostart;
 105
 106 END {
 107     # Skip the remaining cleanup for testcases which set i3_autostart => 0:
 108     return if !defined($i3_pid) && !$i3_autostart;
 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     $x ||= i3test::X11->new;
 139     # set the pointer to a predictable position in case a previous test has
 140     # disturbed it
 141     $x->warp_pointer(
 142         0, # src_window (None)
 143         $x->get_root_window(), # dst_window (None)
 144         0, # src_x
 145         0, # src_y
 146         0, # src_width
 147         0, # src_height
 148         0, # dst_x
 149         0); # dst_y
 150     # Synchronize with X11 to ensure the pointer has been warped before i3
 151     # starts up.
 152     $x->get_input_focus_reply($x->get_input_focus()->{sequence});
 153
 154     $i3_autostart = delete($args{i3_autostart}) // 1;
 155     my $i3_config = delete($args{i3_config}) // '-default';
 156
 157     my $cv = launch_with_config($i3_config, dont_block => 1)
 158         if $i3_autostart;
 159
 160     my $test_more_args = '';
 161     $test_more_args = join(' ', 'qw(', %args, ')') if keys %args;
 162     local $@;
 163     eval << "__";
 164 package $pkg;
 165 use Test::More $test_more_args;
 166 use Data::Dumper;
 167 use AnyEvent::I3;
 168 use Time::HiRes qw(sleep);
 169 use i3test::Test;
 170 __
 171     $tester->BAIL_OUT("$@") if $@;
 172     feature->import(":5.10");
 173     strict->import;
 174     warnings->import;
 175
 176     $cv->recv if $i3_autostart;
 177
 178     @_ = ($class);
 179     goto \&Exporter::import;
 180 }
 181
 182 =head1 EXPORT
 183
 184 =head2 wait_for_event($timeout, $callback)
 185
 186 Waits for the next event and calls the given callback for every event to
 187 determine if this is the event we are waiting for.
 188
 189 Can be used to wait until a window is mapped, until a ClientMessage is
 190 received, etc.
 191
 192   wait_for_event 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
 193
 194 =cut
 195 sub wait_for_event {
 196     my ($timeout, $cb) = @_;
 197
 198     $x->flush;
 199
 200     while (defined(my $event = $x->wait_for_event)) {
 201         return 1 if $cb->($event);
 202     }
 203 }
 204
 205 =head2 wait_for_map($window)
 206
 207 Thin wrapper around wait_for_event which waits for MAP_NOTIFY.
 208 Make sure to include 'structure_notify' in the window’s event_mask attribute.
 209
 210 This function is called by C<open_window>, so in most cases, you don’t need to
 211 call it on your own. If you need special setup of the window before mapping,
 212 you might have to map it on your own and use this function:
 213
 214   my $window = open_window(dont_map => 1);
 215   # Do something special with the window first
 216   # …
 217
 218   # Now map it and wait until it’s been mapped
 219   $window->map;
 220   wait_for_map($window);
 221
 222 =cut
 223 sub wait_for_map {
 224     my ($win) = @_;
 225     my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
 226     wait_for_event 4, sub {
 227         $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id
 228     };
 229 }
 230
 231 =head2 wait_for_unmap($window)
 232
 233 Wrapper around C<wait_for_event> which waits for UNMAP_NOTIFY. Also calls
 234 C<sync_with_i3> to make sure i3 also picked up and processed the UnmapNotify
 235 event.
 236
 237   my $ws = fresh_workspace;
 238   my $window = open_window;
 239   is_num_children($ws, 1, 'one window on workspace');
 240   $window->unmap;
 241   wait_for_unmap;
 242   is_num_children($ws, 0, 'no more windows on this workspace');
 243
 244 =cut
 245 sub wait_for_unmap {
 246     my ($win) = @_;
 247     # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
 248     wait_for_event 4, sub {
 249         $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id
 250     };
 251     sync_with_i3();
 252 }
 253
 254 =head2 open_window([ $args ])
 255
 256 Opens a new window (see C<X11::XCB::Window>), maps it, waits until it got mapped
 257 and synchronizes with i3.
 258
 259 The following arguments can be passed:
 260
 261 =over 4
 262
 263 =item class
 264
 265 The X11 window class (e.g. WINDOW_CLASS_INPUT_OUTPUT), not to be confused with
 266 the WM_CLASS!
 267
 268 =item rect
 269
 270 An arrayref with 4 members specifying the initial geometry (position and size)
 271 of the window, e.g. C<< [ 0, 100, 70, 50 ] >> for a window appearing at x=0, y=100
 272 with width=70 and height=50.
 273
 274 Note that this is entirely irrelevant for tiling windows.
 275
 276 =item background_color
 277
 278 The background pixel color of the window, formatted as "#rrggbb", like HTML
 279 color codes (e.g. #c0c0c0). This is useful to tell windows apart when actually
 280 watching the testcases.
 281
 282 =item event_mask
 283
 284 An arrayref containing strings which describe the X11 event mask we use for that
 285 window. The default is C<< [ 'structure_notify' ] >>.
 286
 287 =item name
 288
 289 The window’s C<_NET_WM_NAME> (UTF-8 window title). By default, this is "Window
 290 n" with n being replaced by a counter to keep windows apart.
 291
 292 =item dont_map
 293
 294 Set to a true value to avoid mapping the window (making it visible).
 295
 296 =item before_map
 297
 298 A coderef which is called before the window is mapped (unless C<dont_map> is
 299 true). The freshly created C<$window> is passed as C<$_> and as the first
 300 argument.
 301
 302 =back
 303
 304 The default values are equivalent to this call:
 305
 306   open_window(
 307     class => WINDOW_CLASS_INPUT_OUTPUT
 308     rect => [ 0, 0, 30, 30 ]
 309     background_color => '#c0c0c0'
 310     event_mask => [ 'structure_notify' ]
 311     name => 'Window <n>'
 312   );
 313
 314 Usually, though, calls are simpler:
 315
 316   my $top_window = open_window;
 317
 318 To identify the resulting window object in i3 commands, use the id property:
 319
 320   my $top_window = open_window;
 321   cmd '[id="' . $top_window->id . '"] kill';
 322
 323 =cut
 324 sub open_window {
 325     my %args = @_ == 1 ? %{$_[0]} : @_;
 326
 327     my $dont_map = delete $args{dont_map};
 328     my $before_map = delete $args{before_map};
 329
 330     $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
 331     $args{rect} //= [ 0, 0, 30, 30 ];
 332     $args{background_color} //= '#c0c0c0';
 333     $args{event_mask} //= [ 'structure_notify' ];
 334     $args{name} //= 'Window ' . counter_window();
 335
 336     my $window = $x->root->create_child(%args);
 337     $window->add_hint('input');
 338
 339     if ($before_map) {
 340         # TODO: investigate why _create is not needed
 341         $window->_create;
 342         $before_map->($window) for $window;
 343     }
 344
 345     return $window if $dont_map;
 346
 347     $window->map;
 348     wait_for_map($window);
 349
 350     # MapWindow is sent before i3 even starts rendering: the window is placed at
 351     # temporary off-screen coordinates first, and x_push_changes() sends further
 352     # X11 requests to set focus etc. Hence, we sync with i3 before continuing.
 353     sync_with_i3();
 354
 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<https://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             dont_map => 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 exit_forcefully($pid, [ $signal ])
 776
 777 Tries to exit i3 forcefully by sending a signal (defaults to SIGTERM).
 778
 779 You only need to use this function if you want to test signal handling
 780 (in which case you must have launched i3 on your own with
 781 C<launch_with_config>).
 782
 783   use i3test i3_autostart => 0;
 784   my $pid = launch_with_config($config);
 785   # …
 786   exit_forcefully($pid);
 787
 788 =cut
 789 sub exit_forcefully {
 790     my ($pid, $signal) = @_;
 791     $signal ||= 'TERM';
 792
 793     # Send the given signal to the i3 instance and wait for up to 10s
 794     # for it to terminate.
 795     kill($signal, $pid)
 796         or $tester->BAIL_OUT("could not kill i3: $!");
 797     my $status;
 798     my $timeout = 10;
 799     do {
 800         $status = waitpid $pid, WNOHANG;
 801
 802         if ($status <= 0) {
 803             sleep(1);
 804             $timeout--;
 805         }
 806     } while ($status <= 0 && $timeout > 0);
 807
 808     if ($status <= 0) {
 809         kill('KILL', $pid)
 810             or $tester->BAIL_OUT("could not kill i3: $!");
 811         waitpid $pid, 0;
 812     }
 813     undef $i3_pid;
 814 }
 815
 816 =head2 get_socket_path([ $cache ])
 817
 818 Gets the socket path from the C<I3_SOCKET_PATH> atom stored on the X11 root
 819 window. After the first call, this function will return a cached version of the
 820 socket path unless you specify a false value for C<$cache>.
 821
 822   my $i3 = i3(get_socket_path());
 823   $i3->command('nop test example')->recv;
 824
 825 To avoid caching:
 826
 827   my $i3 = i3(get_socket_path(0));
 828
 829 =cut
 830 sub get_socket_path {
 831     my ($cache) = @_;
 832     $cache //= 1;
 833
 834     if ($cache && defined($_cached_socket_path)) {
 835         return $_cached_socket_path;
 836     }
 837     my $socketpath = i3test::Util::get_socket_path($x);
 838     $_cached_socket_path = $socketpath;
 839     return $socketpath;
 840 }
 841
 842 =head2 launch_with_config($config, [ $args ])
 843
 844 Launches a new i3 process with C<$config> as configuration file. Useful for
 845 tests which test specific config file directives.
 846
 847   use i3test i3_autostart => 0;
 848
 849   my $config = <<EOT;
 850   # i3 config file (v4)
 851   for_window [class="borderless"] border none
 852   for_window [title="special borderless title"] border none
 853   EOT
 854
 855   my $pid = launch_with_config($config);
 856
 857   # …
 858
 859   exit_gracefully($pid);
 860
 861 =cut
 862 sub launch_with_config {
 863     my ($config, %args) = @_;
 864
 865     $tmp_socket_path = "/tmp/nested-$ENV{DISPLAY}";
 866
 867     $args{dont_create_temp_dir} //= 0;
 868     $args{validate_config} //= 0;
 869
 870     my ($fh, $tmpfile) = tempfile("i3-cfg-for-$ENV{TESTNAME}-XXXXX", UNLINK => 1);
 871
 872     say $fh "ipc-socket $tmp_socket_path"
 873         unless $args{dont_add_socket_path};
 874
 875     if ($config ne '-default') {
 876         print $fh $config;
 877     } else {
 878         open(my $conf_fh, '<', '@abs_top_srcdir@/testcases/i3-test.config')
 879             or $tester->BAIL_OUT("could not open default config: $!");
 880         local $/;
 881         say $fh scalar <$conf_fh>;
 882     }
 883
 884     close($fh);
 885
 886     my $cv = AnyEvent->condvar;
 887     $i3_pid = activate_i3(
 888         unix_socket_path => "$tmp_socket_path-activation",
 889         display => $ENV{DISPLAY},
 890         configfile => $tmpfile,
 891         outdir => $ENV{OUTDIR},
 892         testname => $ENV{TESTNAME},
 893         valgrind => $ENV{VALGRIND},
 894         strace => $ENV{STRACE},
 895         xtrace => $ENV{XTRACE},
 896         restart => $ENV{RESTART},
 897         cv => $cv,
 898         dont_create_temp_dir => $args{dont_create_temp_dir},
 899         validate_config => $args{validate_config},
 900         inject_randr15 => $args{inject_randr15},
 901         inject_randr15_outputinfo => $args{inject_randr15_outputinfo},
 902     );
 903
 904     # If we called i3 with -C, we wait for it to exit and then return as
 905     # there's nothing else we need to do.
 906     if ($args{validate_config}) {
 907         $cv->recv;
 908         waitpid $i3_pid, 0;
 909
 910         # We need this since exit_gracefully will not be called in this case.
 911         undef $i3_pid;
 912
 913         return ${^CHILD_ERROR_NATIVE};
 914     }
 915
 916     # force update of the cached socket path in lib/i3test
 917     # as soon as i3 has started
 918     $cv->cb(sub { get_socket_path(0) });
 919
 920     return $cv if $args{dont_block};
 921
 922     # blockingly wait until i3 is ready
 923     $cv->recv;
 924
 925     return $i3_pid;
 926 }
 927
 928 =head2 get_i3_log
 929
 930 Returns the content of the log file for the current test.
 931
 932 =cut
 933 sub get_i3_log {
 934     my $logfile = "$ENV{OUTDIR}/i3-log-for-$ENV{TESTNAME}";
 935     return slurp($logfile);
 936 }
 937
 938 =head2 kill_all_windows
 939
 940 Kills all windows to clean up between tests.
 941
 942 =cut
 943 sub kill_all_windows {
 944     # Sync in case not all windows are managed by i3 just yet.
 945     sync_with_i3;
 946     cmd '[title=".*"] kill';
 947 }
 948
 949 =head2 events_for($subscribecb, [ $rettype ], [ $eventcbs ])
 950
 951 Helper function which returns an array containing all events of type $rettype
 952 which were generated by i3 while $subscribecb was running.
 953
 954 Set $eventcbs to subscribe to multiple event types and/or perform your own event
 955 aggregation.
 956
 957 =cut
 958 sub events_for {
 959     my ($subscribecb, $rettype, $eventcbs) = @_;
 960
 961     my @events;
 962     $eventcbs //= {};
 963     if (defined($rettype)) {
 964         $eventcbs->{$rettype} = sub { push @events, shift };
 965     }
 966     my $subscribed = AnyEvent->condvar;
 967     my $flushed = AnyEvent->condvar;
 968     $eventcbs->{tick} = sub {
 969         my ($event) = @_;
 970         if ($event->{first}) {
 971             $subscribed->send($event);
 972         } else {
 973             $flushed->send($event);
 974         }
 975     };
 976     my $i3 = i3(get_socket_path(0));
 977     $i3->connect->recv;
 978     $i3->subscribe($eventcbs)->recv;
 979     $subscribed->recv;
 980     # Subscription established, run the callback.
 981     $subscribecb->();
 982     # Now generate a tick event, which we know we’ll receive (and at which point
 983     # all other events have been received).
 984     my $nonce = int(rand(255)) + 1;
 985     $i3->send_tick($nonce);
 986
 987     my $tick = $flushed->recv;
 988     $tester->is_eq($tick->{payload}, $nonce, 'tick nonce received');
 989     return @events;
 990 }
 991
 992 =head2 listen_for_binding($cb)
 993
 994 Helper function to evaluate whether sending KeyPress/KeyRelease events via XTEST
 995 triggers an i3 key binding or not. Expects key bindings to be configured in the
 996 form “bindsym <binding> nop <binding>”, e.g.  “bindsym Mod4+Return nop
 997 Mod4+Return”.
 998
 999   is(listen_for_binding(
1000       sub {
1001           xtest_key_press(133); # Super_L
1002           xtest_key_press(36); # Return
1003           xtest_key_release(36); # Return
1004           xtest_key_release(133); # Super_L
1005           xtest_sync_with_i3;
1006       },
1007       ),
1008      'Mod4+Return',
1009      'triggered the "Mod4+Return" keybinding');
1010
1011 =cut
1012
1013 sub listen_for_binding {
1014     my ($cb) = @_;
1015     my $triggered = AnyEvent->condvar;
1016     my @events = events_for(
1017         $cb,
1018         'binding');
1019
1020     $tester->is_eq(scalar @events, 1, 'Received precisely one event');
1021     $tester->is_eq($events[0]->{change}, 'run', 'change is "run"');
1022     # We look at the command (which is “nop <binding>”) because that is easier
1023     # than re-assembling the string representation of $event->{binding}.
1024     my $command = $events[0]->{binding}->{command};
1025     $command =~ s/^nop //g;
1026     return $command;
1027 }
1028
1029 =head1 AUTHOR
1030
1031 Michael Stapelberg <michael@i3wm.org>
1032
1033 =cut
1034
1035 package i3test::X11;
1036 use parent 'X11::XCB::Connection';
1037
1038 sub input_focus {
1039     my $self = shift;
1040     i3test::sync_with_i3();
1041
1042     return $self->SUPER::input_focus(@_);
1043 }
1044
1045 1