]> git.sur5r.net Git - i3/i3/blobdiff - testcases/lib/i3test.pm
Merge branch 'master' into next
[i3/i3] / testcases / lib / i3test.pm
index 9b7cc13809944448c9b4af56569cf9b240a81633..8437a534a1971250946119c9d133ccbf50099c54 100644 (file)
@@ -1,5 +1,6 @@
 package i3test;
 # vim:ts=4:sw=4:expandtab
+use strict; use warnings;
 
 use File::Temp qw(tmpnam tempfile tempdir);
 use Test::Builder;
@@ -7,10 +8,10 @@ use X11::XCB::Rect;
 use X11::XCB::Window;
 use X11::XCB qw(:all);
 use AnyEvent::I3;
-use EV;
 use List::Util qw(first);
 use Time::HiRes qw(sleep);
 use Cwd qw(abs_path);
+use Scalar::Util qw(blessed);
 use SocketActivation;
 
 use v5.10;
@@ -38,6 +39,7 @@ our @EXPORT = qw(
     wait_for_event
     wait_for_map
     wait_for_unmap
+    $x
 );
 
 my $tester = Test::Builder->new();
@@ -45,6 +47,8 @@ my $_cached_socket_path = undef;
 my $_sync_window = undef;
 my $tmp_socket_path = undef;
 
+our $x;
+
 BEGIN {
     my $window_count = 0;
     sub counter_window {
@@ -55,16 +59,22 @@ BEGIN {
 sub import {
     my $class = shift;
     my $pkg = caller;
-    eval "package $pkg;
-use Test::Most" . (@_ > 0 ? " qw(@_)" : "") . ";
+
+    my $test_more_args = @_ ? "qw(@_)" : "";
+    local $@;
+    eval << "__";
+package $pkg;
+use Test::More $test_more_args;
 use Data::Dumper;
 use AnyEvent::I3;
 use Time::HiRes qw(sleep);
-use Test::Deep qw(eq_deeply cmp_deeply cmp_set cmp_bag cmp_methods useclass noclass set bag subbagof superbagof subsetof supersetof superhashof subhashof bool str arraylength Isa ignore methods regexprefonly regexpmatches num regexponly scalref reftype hashkeysonly blessed array re hash regexpref hash_each shallow array_each code arrayelementsonly arraylengthonly scalarrefonly listmethods any hashkeys isa);
-use v5.10;
-use strict;
-use warnings;
-";
+__
+    $tester->bail_out("$@") if $@;
+    feature->import(":5.10");
+    strict->import;
+    warnings->import;
+
+    $x ||= i3test::X11->new;
     @_ = ($class);
     goto \&Exporter::import;
 }
@@ -79,15 +89,16 @@ use warnings;
 # wait_for_event $x, 0.25, sub { $_[0]->{response_type} == MAP_NOTIFY };
 #
 sub wait_for_event {
-    my ($x, $timeout, $cb) = @_;
+    my ($timeout, $cb) = @_;
 
     my $cv = AE::cv;
 
-    my $prep = EV::prepare sub {
-        $x->flush;
-    };
+    $x->flush;
+
+    # unfortunately, there is no constant for this
+    my $ae_read = 0;
 
-    my $check = EV::check sub {
+    my $guard = AE::io $x->get_file_descriptor, $ae_read, sub {
         while (defined(my $event = $x->poll_for_event)) {
             if ($cb->($event)) {
                 $cv->send(1);
@@ -96,32 +107,35 @@ sub wait_for_event {
         }
     };
 
-    my $watcher = EV::io $x->get_file_descriptor, EV::READ, sub {
-        # do nothing, we only need this watcher so that EV picks up the events
-    };
-
     # Trigger timeout after $timeout seconds (can be fractional)
     my $t = AE::timer $timeout, 0, sub { warn "timeout ($timeout secs)"; $cv->send(0) };
 
     my $result = $cv->recv;
     undef $t;
+    undef $guard;
     return $result;
 }
 
 # thin wrapper around wait_for_event which waits for MAP_NOTIFY
 # make sure to include 'structure_notify' in the window’s event_mask attribute
 sub wait_for_map {
-    my ($x) = @_;
-    wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY };
+    my ($win) = @_;
+    my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
+    wait_for_event 2, sub {
+        $_[0]->{response_type} == MAP_NOTIFY and $_[0]->{window} == $id
+    };
 }
 
 # Wrapper around wait_for_event which waits for UNMAP_NOTIFY. Also calls
 # sync_with_i3 to make sure i3 also picked up and processed the UnmapNotify
 # event.
 sub wait_for_unmap {
-    my ($x) = @_;
-    wait_for_event $x, 2, sub { $_[0]->{response_type} == UNMAP_NOTIFY };
-    sync_with_i3($x);
+    my ($win) = @_;
+    # my $id = (blessed($win) && $win->isa('X11::XCB::Window')) ? $win->id : $win;
+    wait_for_event 2, sub {
+        $_[0]->{response_type} == UNMAP_NOTIFY # and $_[0]->{window} == $id
+    };
+    sync_with_i3();
 }
 
 #
@@ -130,6 +144,12 @@ sub wait_for_unmap {
 #
 # set dont_map to a true value to avoid mapping
 #
+# if you want to change aspects of your window before it would be mapped,
+# set before_map to a coderef. $window gets passed as $_ and as first argument.
+#
+# if you set both dont_map and before_map, the coderef will be called nevertheless
+#
+#
 # default values:
 #     class => WINDOW_CLASS_INPUT_OUTPUT
 #     rect => [ 0, 0, 30, 30 ]
@@ -138,10 +158,10 @@ sub wait_for_unmap {
 #     name => 'Window <n>'
 #
 sub open_window {
-    my ($x, $args) = @_;
-    my %args = ($args ? %$args : ());
+    my %args = @_ == 1 ? %{$_[0]} : @_;
 
     my $dont_map = delete $args{dont_map};
+    my $before_map = delete $args{before_map};
 
     $args{class} //= WINDOW_CLASS_INPUT_OUTPUT;
     $args{rect} //= [ 0, 0, 30, 30 ];
@@ -151,24 +171,27 @@ sub open_window {
 
     my $window = $x->root->create_child(%args);
 
+    if ($before_map) {
+        # TODO: investigate why _create is not needed
+        $window->_create;
+        $before_map->($window) for $window;
+    }
+
     return $window if $dont_map;
 
     $window->map;
-    wait_for_map($x);
-    # We sync with i3 here to make sure $x->input_focus is updated.
-    sync_with_i3($x);
+    wait_for_map($window);
     return $window;
 }
 
 # Thin wrapper around open_window which sets window_type to
 # _NET_WM_WINDOW_TYPE_UTILITY to make the window floating.
 sub open_floating_window {
-    my ($x, $args) = @_;
-    my %args = ($args ? %$args : ());
+    my %args = @_ == 1 ? %{$_[0]} : @_;
 
     $args{window_type} = $x->atom(name => '_NET_WM_WINDOW_TYPE_UTILITY');
 
-    return open_window($x, \%args);
+    return open_window(\%args);
 }
 
 sub open_empty_con {
@@ -243,7 +266,7 @@ sub get_focused {
         $lf = $focused[0];
         last unless defined($con->{focus});
         @focused = @{$con->{focus}};
-        @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
+        my @cons = grep { $_->{id} == $lf } (@{$con->{nodes}}, @{$con->{'floating_nodes'}});
         $con = $cons[0];
     }
 
@@ -307,23 +330,14 @@ sub focused_ws {
 # See also docs/testsuite for a long explanation
 #
 sub sync_with_i3 {
-    my ($x) = @_;
-
     # Since we need a (mapped) window for receiving a ClientMessage, we create
     # one on the first call of sync_with_i3. It will be re-used in all
     # subsequent calls.
     if (!defined($_sync_window)) {
-        $_sync_window = $x->root->create_child(
-            class => WINDOW_CLASS_INPUT_OUTPUT,
-            rect => X11::XCB::Rect->new(x => -15, y => -15, width => 10, height => 10 ),
+        $_sync_window = open_window(
+            rect => [ -15, -15, 10, 10 ],
             override_redirect => 1,
-            background_color => '#ff0000',
-            event_mask => [ 'structure_notify' ],
         );
-
-        $_sync_window->map;
-
-        wait_for_event $x, 2, sub { $_[0]->{response_type} == MAP_NOTIFY };
     }
 
     my $root = $x->get_root_window();
@@ -349,7 +363,7 @@ sub sync_with_i3 {
     $x->send_event(0, $root, EVENT_MASK_SUBSTRUCTURE_REDIRECT, $msg);
 
     # now wait until the reply is here
-    return wait_for_event $x, 2, sub {
+    return wait_for_event 2, sub {
         my ($event) = @_;
         # TODO: const
         return 0 unless $event->{response_type} == 161;
@@ -397,7 +411,6 @@ sub get_socket_path {
         return $_cached_socket_path;
     }
 
-    my $x = X11::XCB::Connection->new;
     my $atom = $x->atom(name => 'I3_SOCKET_PATH');
     my $cookie = $x->get_property(0, $x->get_root_window(), $atom->id, GET_PROPERTY_TYPE_ANY, 0, 256);
     my $reply = $x->get_property_reply($cookie->{sequence});
@@ -422,7 +435,7 @@ sub launch_with_config {
         $tmp_socket_path = File::Temp::tempnam('/tmp', 'i3-test-socket-');
     }
 
-    my ($fh, $tmpfile) = tempfile('i3-test-config-XXXXX', UNLINK => 1);
+    my ($fh, $tmpfile) = tempfile('/tmp/i3-test-config-XXXXX', UNLINK => 1);
     say $fh $config;
     say $fh "ipc-socket $tmp_socket_path" unless $dont_add_socket_path;
     close($fh);
@@ -432,7 +445,10 @@ sub launch_with_config {
         unix_socket_path => "$tmp_socket_path-activation",
         display => $ENV{DISPLAY},
         configfile => $tmpfile,
-        logpath => $ENV{LOGPATH},
+        outdir => $ENV{OUTDIR},
+        testname => $ENV{TESTNAME},
+        valgrind => $ENV{VALGRIND},
+        strace => $ENV{STRACE},
         cv => $cv,
     );
 
@@ -445,4 +461,14 @@ sub launch_with_config {
     return $pid;
 }
 
+package i3test::X11;
+use parent 'X11::XCB::Connection';
+
+sub input_focus {
+    my $self = shift;
+    i3test::sync_with_i3();
+
+    return $self->SUPER::input_focus(@_);
+}
+
 1