git.sur5r.net Git - i3/i3/blob - testcases/t/294-update-ewmh-atoms.t

   1 #!perl
   2 # vim:ts=4:sw=4:expandtab
   3 #
   4 # Please read the following documents before working on tests:
   5 # • https://build.i3wm.org/docs/testsuite.html
   6 #   (or docs/testsuite)
   7 #
   8 # • https://build.i3wm.org/docs/lib-i3test.html
   9 #   (alternatively: perldoc ./testcases/lib/i3test.pm)
  10 #
  11 # • https://build.i3wm.org/docs/ipc.html
  12 #   (or docs/ipc)
  13 #
  14 # • http://onyxneon.com/books/modern_perl/modern_perl_a4.pdf
  15 #   (unless you are already familiar with Perl)
  16 #
  17 # Verifies _NET_DESKTOP_NAMES, _NET_CURRENT_DESKTOP and _NET_CURRENT_DESKTOP
  18 # are updated properly when closing an inactive workspace container.
  19 # See github issue #3126
  20
  21 use i3test;
  22
  23 sub get_desktop_names {
  24     sync_with_i3;
  25
  26     my $cookie = $x->get_property(
  27         0,
  28         $x->get_root_window(),
  29         $x->atom(name => '_NET_DESKTOP_NAMES')->id,
  30         $x->atom(name => 'UTF8_STRING')->id,
  31         0,
  32         4096,
  33     );
  34
  35     my $reply = $x->get_property_reply($cookie->{sequence});
  36
  37     return 0 if $reply->{value_len} == 0;
  38
  39     # the property is a null-delimited list of utf8 strings ;;
  40     return split /\0/, $reply->{value};
  41 }
  42
  43 sub get_num_of_desktops {
  44     sync_with_i3;
  45
  46     my $cookie = $x->get_property(
  47         0,
  48         $x->get_root_window(),
  49         $x->atom(name => '_NET_NUMBER_OF_DESKTOPS')->id,
  50         $x->atom(name => 'CARDINAL')->id,
  51         0,
  52         4,
  53     );
  54
  55     my $reply = $x->get_property_reply($cookie->{sequence});
  56
  57     return undef if $reply->{value_len} != 1;
  58     return undef if $reply->{format} != 32;
  59     return undef if $reply->{type} != $x->atom(name => 'CARDINAL')->id,;
  60
  61     return unpack 'L', $reply->{value};
  62 }
  63
  64 sub get_current_desktop {
  65     sync_with_i3;
  66
  67     my $cookie = $x->get_property(
  68         0,
  69         $x->get_root_window(),
  70         $x->atom(name => '_NET_CURRENT_DESKTOP')->id,
  71         $x->atom(name => 'CARDINAL')->id,
  72         0,
  73         4,
  74     );
  75
  76     my $reply = $x->get_property_reply($cookie->{sequence});
  77
  78     return undef if $reply->{value_len} != 1;
  79     return undef if $reply->{format} != 32;
  80     return undef if $reply->{type} != $x->atom(name => 'CARDINAL')->id,;
  81
  82     return unpack 'L', $reply->{value};
  83 }
  84
  85 cmd 'workspace 0';
  86 my $first = open_window;
  87
  88 cmd 'workspace 1';
  89 my $second = open_window;
  90
  91 cmd 'workspace 2';
  92 my $third = open_window;
  93
  94 # Sanity check
  95 is(get_current_desktop, 2);
  96 is(get_num_of_desktops, 3);
  97 my @actual_names = get_desktop_names;
  98 my @expected_names = ('0', '1', '2');
  99 is_deeply(\@actual_names, \@expected_names);
 100
 101 # Kill first window to close a workspace.
 102 cmd '[id="' . $second->id . '"] kill';
 103
 104 is(get_current_desktop, 2, '_NET_CURRENT_DESKTOP should be updated');
 105 is(get_num_of_desktops, 2, '_NET_NUMBER_OF_DESKTOPS should be updated');
 106 my @actual_names = get_desktop_names;
 107 my @expected_names = ('0', '2');
 108 is_deeply(\@actual_names, \@expected_names, '_NET_DESKTOP_NAMES should be updated');
 109
 110
 111 done_testing;