1#!/usr/bin/perl -w
2
3# Copyright 2012, 2013 Kevin Ryde
4
5# This file is part of X11-Protocol-Other.
6#
7# X11-Protocol-Other is free software; you can redistribute it and/or
8# modify it under the terms of the GNU General Public License as published
9# by the Free Software Foundation; either version 3, or (at your option) any
10# later version.
11#
12# X11-Protocol-Other is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
15# Public License for more details.
16#
17# You should have received a copy of the GNU General Public License along
18# with X11-Protocol-Other.  If not, see <http://www.gnu.org/licenses/>.
19
20BEGIN { require 5 }
21use strict;
22use X11::Protocol;
23use Test;
24
25use lib 't';
26use MyTestHelpers;
27BEGIN { MyTestHelpers::nowarnings() }
28END { MyTestHelpers::diag ("END"); }
29
30# uncomment this to run the ### lines
31# use Smart::Comments;
32
33my $test_count = (tests => 158)[1];
34plan tests => $test_count;
35
36require X11::Protocol;
37MyTestHelpers::diag ("X11::Protocol version ", X11::Protocol->VERSION);
38
39my $display = $ENV{'DISPLAY'};
40if (! defined $display) {
41  foreach (1 .. $test_count) {
42    skip ('No DISPLAY set', 1, 1);
43  }
44  exit 0;
45}
46
47# pass display arg so as not to get a "guess" warning
48my $X;
49if (! eval { $X = X11::Protocol->new ($display); }) {
50  MyTestHelpers::diag ('Cannot connect to X server -- ',$@);
51  foreach (1 .. $test_count) {
52    skip ('Cannot connect to X server', 1, 1);
53  }
54  exit 0;
55}
56$X->QueryPointer($X->{'root'});  # sync
57
58my ($major_opcode, $first_event, $first_error)
59  = $X->QueryExtension('SYNC');
60{
61  if (! defined $major_opcode) {
62    foreach (1 .. $test_count) {
63      skip ('QueryExtension() no SYNC on the server', 1, 1);
64    }
65    exit 0;
66  }
67  MyTestHelpers::diag ("SYNC extension opcode=$major_opcode event=$first_event error=$first_error");
68}
69
70if (! $X->init_extension ('SYNC')) {
71  die "QueryExtension says SYNC avaiable, but init_extension() failed";
72}
73$X->QueryPointer($X->root); # sync
74
75
76#------------------------------------------------------------------------------
77# Helpers.
78
79# Return $b << $n, with $b converted to a Math::BigInt for the shift.
80# No "<<" operator in old Math::BigInt, so this is implemented with "**".
81sub big_leftshift {
82  my ($b, $n) = @_;
83  require Math::BigInt;
84  return Math::BigInt->new("$b") * Math::BigInt->new(2) ** $n;
85}
86
87
88#------------------------------------------------------------------------------
89# _hilo_to_int64()
90# Note explicit stringizing to cope with old Math::BigInt.
91
92MyTestHelpers::diag ("_INT_BITS() is ", X11::Protocol::Ext::SYNC::_INT_BITS());
93
94{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,1);
95  $ret = "$ret";
96  $ret =~ s/^\+//;
97  ok ($ret == 1, 1);
98}
99{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,0x8000_0000);
100  $ret = "$ret";
101  $ret =~ s/^\+//;
102  ok ($ret, '2147483648');
103}
104{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,0xFFFF_FFFF);
105  $ret = "$ret";
106  $ret =~ s/^\+//;
107  ok ($ret, '4294967295');
108}
109{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0x8000_0000,3);
110  $ret = "$ret";
111  $ret =~ s/^\+//;
112  ok ($ret, '-9223372036854775805');
113}
114{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0x1234_5678, 0x8765_4321);
115  $ret = "$ret";
116  $ret =~ s/^\+//;
117  ok ($ret, '1311768467139281697');
118}
119{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0xFFFF_FFFF, 0xFFFF_FFFF);
120  $ret = "$ret";
121  $ret =~ s/^\+//;
122  ok ($ret == -1, 1);
123}
124
125#------------------------------------------------------------------------------
126# _int64_to_hilo()
127
128{ my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo(0);
129  ok (scalar(@ret), 2);
130  ok ($ret[0] == 0, 1);
131  ok ($ret[1] == 0, 1);
132}
133{ my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo(-1);
134  ok (scalar(@ret), 2);
135  ok ($ret[0] == 0xFFFF_FFFF, 1);
136  ok ($ret[1] == 0xFFFF_FFFF, 1);
137}
138{ my $sv = big_leftshift(1,32);
139  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
140  ok (scalar(@ret), 2);
141  ok ($ret[0] == 1, 1);
142  ok ($ret[1] == 0, 1);
143}
144{ my $sv = big_leftshift(1,63) - 1;
145  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
146  ok (scalar(@ret), 2);
147  ok ($ret[0] == 0x7FFF_FFFF, 1);
148  ok ($ret[1] == 0xFFFF_FFFF, 1);
149}
150{ # -8000_0000 0000_0000
151  my $sv = - big_leftshift(1,63);
152  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
153  ok (scalar(@ret), 2);
154  ok ($ret[0] == 0x8000_0000, 1,  "-800..00 hi got $ret[0]");
155  ok ($ret[1] == 0,           1);
156}
157{ # -4000_0000 0000_0001
158  my $sv = - big_leftshift(1,62) - 1;
159  my ($hi,$lo) = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
160  ok ($hi == 0xBFFF_FFFF, 1);
161  ok ($lo == 0xFFFF_FFFF, 1);
162}
163
164{
165  # -7FFF_FFFF FFFF_FFFF
166  my $sv = - big_leftshift(1,63) + 1;
167  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
168  ok (scalar(@ret), 2);
169  ok ($ret[0] == 0x8000_0000, 1,  "-7FF..FF hi got $ret[0]");
170  ok ($ret[1] == 1,           1,  "-7FF..FF lo want 1 got $ret[0]");
171  MyTestHelpers::diag ("sv=$sv   hi=$ret[0] lo=$ret[1]");
172}
173
174#------------------------------------------------------------------------------
175# errors
176
177{
178  ok ($X->num('Error','Counter'),    $first_error);
179  ok ($X->num('Error','Alarm'),      $first_error+1);
180  ok ($X->num('Error',$first_error),   $first_error);
181  ok ($X->num('Error',$first_error+1), $first_error+1);
182  ok ($X->interp('Error',$first_error),   'Counter');
183  ok ($X->interp('Error',$first_error+1), 'Alarm');
184  {
185    local $X->{'do_interp'} = 0;
186    ok ($X->interp('Error',$first_error), $first_error);
187    ok ($X->interp('Error',$first_error+1), $first_error+1);
188  }
189}
190
191
192#------------------------------------------------------------------------------
193# SyncTestType enum
194
195ok ($X->num('SyncTestType','PositiveTransition'),   0);
196ok ($X->num('SyncTestType','NegativeTransition'),   1);
197ok ($X->num('SyncTestType','PositiveComparison'),   2);
198ok ($X->num('SyncTestType','NegativeComparison'),   3);
199
200ok ($X->interp('SyncTestType',0), 'PositiveTransition');
201ok ($X->interp('SyncTestType',1), 'NegativeTransition');
202ok ($X->interp('SyncTestType',2), 'PositiveComparison');
203ok ($X->interp('SyncTestType',3), 'NegativeComparison');
204
205
206#------------------------------------------------------------------------------
207# SyncValueType enum
208
209ok ($X->num('SyncValueType','Absolute'),   0);
210ok ($X->num('SyncValueType','Relative'),   1);
211
212ok ($X->interp('SyncValueType',0), 'Absolute');
213ok ($X->interp('SyncValueType',1), 'Relative');
214
215
216#------------------------------------------------------------------------------
217# SyncAlarmState enum
218
219ok ($X->num('SyncAlarmState','Active'),    0);
220ok ($X->num('SyncAlarmState','Inactive'),  1);
221ok ($X->num('SyncAlarmState','Destroyed'), 2);
222
223ok ($X->interp('SyncAlarmState',0), 'Active');
224ok ($X->interp('SyncAlarmState',1), 'Inactive');
225ok ($X->interp('SyncAlarmState',2), 'Destroyed');
226
227
228#------------------------------------------------------------------------------
229# SyncCreateCounter / SyncDestroyCounter
230
231{
232  my $counter = $X->new_rsrc;
233  $X->SyncCreateCounter ($counter, 123);
234  $X->QueryPointer($X->root); # sync
235  ok (1, 1, 'SyncCreateCounter');
236
237  { my $value = $X->SyncQueryCounter ($counter);
238    $value = "$value";
239    $value =~ s/^\+//;
240    ok ($value, 123);
241  }
242
243  { my $value;
244    foreach $value (0, 1, -1,
245                    big_leftshift(1,32),
246                    - big_leftshift(1,32),
247                    big_leftshift(1,63) - 1,
248                    - big_leftshift(1,63),
249                   ) {
250      $X->SyncSetCounter ($counter, $value);
251      my $got_value = $X->SyncQueryCounter ($counter);
252      ok ($got_value == $value, 1,
253          "counter $value got $got_value");
254    }
255  }
256
257  $X->SyncDestroyCounter ($counter);
258  $X->QueryPointer($X->root); # sync
259  ok (1, 1, 'SyncDestroyCounter');
260}
261
262#------------------------------------------------------------------------------
263# SyncCreateAlarm / SyncDestroyAlarm
264
265{
266  my $alarm = $X->new_rsrc;
267  $X->SyncCreateAlarm ($alarm);
268
269  $X->SyncDestroyAlarm ($alarm);
270  $X->QueryPointer($X->root); # sync
271  ok (1, 1, 'SyncCreateAlarm / SyncDestroyAlarm');
272}
273
274#------------------------------------------------------------------------------
275# alarm parameters
276
277{
278  my $counter = $X->new_rsrc;
279  $X->SyncCreateCounter ($counter, 123);
280  my $alarm = $X->new_rsrc;
281  $X->SyncCreateAlarm ($alarm, value => -123);
282
283  { my %h = $X->SyncQueryAlarm ($alarm);
284    ok ($h{'value'} == -123,                     1);
285    ok ($h{'test_type'} eq 'PositiveComparison', 1);
286    ok ($h{'value_type'} eq 'Absolute',          1);
287    ok ($h{'delta'} == 1,          1);
288    ok ($h{'events'} == 1,         1);
289    ok ($h{'state'} eq 'Inactive', 1);
290
291    # print $h{'delta'},"\n";
292    # use Devel::Peek;
293    # Dump($h{'delta'});
294  }
295
296  {
297    $X->SyncChangeAlarm ($alarm,
298                         test_type => 'NegativeComparison',
299                         delta => -1);
300    my %h = $X->SyncQueryAlarm ($alarm);
301    ok ($h{'test_type'}, 'NegativeComparison');
302    ok ($h{'delta'} == -1, 1);
303  }
304  {
305    $X->SyncChangeAlarm ($alarm,
306                         counter    => $counter,
307                         value_type => 'Relative');
308    my %h = $X->SyncQueryAlarm ($alarm);
309    ok ($h{'counter'}, $counter);
310  }
311  {
312    $X->SyncChangeAlarm ($alarm, value_type => 'Absolute');
313    my %h = $X->SyncQueryAlarm ($alarm);
314    ok ($h{'value_type'}, 'Absolute');
315    ok ($h{'events'}, 1);
316  }
317  {
318    $X->SyncChangeAlarm ($alarm, events => 0);
319    my %h = $X->SyncQueryAlarm ($alarm);
320    ok ($h{'events'}, 0);
321  }
322
323  $X->SyncDestroyAlarm ($alarm);
324  $X->SyncDestroyCounter ($counter);
325  $X->QueryPointer($X->root); # sync
326}
327
328#------------------------------------------------------------------------------
329# SyncCounterNotify event
330
331{
332  my $aref = $X->{'ext'}->{'SYNC'};
333  my ($request_num, $event_num, $error_num, $obj) = @$aref;
334
335  my $more;
336  foreach $more (0, 1) {
337    my $time;
338    foreach $time ('CurrentTime', 103) {
339      my %input = (# can't use "name" on an extension event, in
340                   # X11::Protocol 0.56
341                   # name        => "SyncCounterNotify",
342                   synthetic     => 1,
343                   code          => $event_num,
344                   sequence_number => 100,
345
346                   counter       => 101,
347                   wait_value    => -123,
348                   counter_value => -256,
349                   time          => $time,
350                   count         => 6,
351                   destroyed     => 1,
352                  );
353      my $data = $X->pack_event(%input);
354      ok (length($data), 32);
355
356      my %output = $X->unpack_event($data);
357      ### %output
358
359      ok ($output{'code'},      $input{'code'});
360      ok ($output{'name'},      'SyncCounterNotify');
361      ok ($output{'synthetic'}, $input{'synthetic'});
362
363      ok ($output{'counter'},      $input{'counter'});
364      ok ($output{'wait_value'},   $input{'wait_value'});
365      ok ($output{'counter_value'},$input{'counter_value'});
366      ok ($output{'time'},         $input{'time'});
367      ok ($output{'count'},        $input{'count'});
368      ok ($output{'destroyed'},    $input{'destroyed'});
369    }
370  }
371}
372
373#------------------------------------------------------------------------------
374# SyncAlarmNotify event
375
376{
377  my $aref = $X->{'ext'}->{'SYNC'};
378  my ($request_num, $event_num, $error_num, $obj) = @$aref;
379  my $alarm_event_num = $event_num + 1;
380
381  my $more;
382  foreach $more (0, 1) {
383    my $time;
384    foreach $time ('CurrentTime', 103) {
385      my %input = (# can't use "name" on an extension event, in
386                   # X11::Protocol 0.56
387                   # name          => "SyncAlarmNotify",
388                   synthetic       => 1,
389                   code            => $alarm_event_num,
390                   sequence_number => 100,
391
392                   alarm         => 101,
393                   counter_value => -123,
394                   alarm_value   => -256,
395                   time          => $time,
396                   state         => 'Destroyed',
397                  );
398      my $data = $X->pack_event(%input);
399      ok (length($data), 32);
400
401      my %output = $X->unpack_event($data);
402      ### %output
403
404      ok ($output{'code'},      $input{'code'});
405      ok ($output{'name'},      'SyncAlarmNotify');
406      ok ($output{'synthetic'}, $input{'synthetic'});
407
408      ok ($output{'alarm'},         $input{'alarm'});
409      ok ($output{'counter_value'}, $input{'counter_value'});
410      ok ($output{'alarm_value'},   $input{'alarm_value'});
411      ok ($output{'time'},          $input{'time'});
412      ok ($output{'state'},         $input{'state'});
413    }
414  }
415}
416
417
418#------------------------------------------------------------------------------
419# SyncSetPriority / SyncGetPriority
420
421{
422  $X->SyncSetPriority(0,123);
423  ok ($X->SyncGetPriority(0), 123);
424
425  $X->SyncSetPriority("None",-123);
426  ok ($X->SyncGetPriority(0), -123);
427
428  $X->SyncSetPriority(0,0);
429  ok ($X->SyncGetPriority(0), 0);
430
431  # second client connection
432  my $X2 = X11::Protocol->new ($display);
433  my $pixmap2 = $X2->new_rsrc;
434  $X2->CreatePixmap($pixmap2, $X2->root, 1, 1,1);
435  $X2->QueryPointer($X->root); # sync
436
437  $X->SyncSetPriority($pixmap2, 456);
438  ok ($X->SyncGetPriority($pixmap2), 456);
439  ok ($X2->SyncGetPriority(0), 456);
440  ok ($X->SyncGetPriority(0), 0);
441
442  my $pixmap = $X->new_rsrc;
443  $X->CreatePixmap($pixmap, $X2->root, 1, 1,1);
444  ok ($X->SyncGetPriority($pixmap), 0);
445  $X->FreePixmap($pixmap);
446}
447
448
449#------------------------------------------------------------------------------
450
451exit 0;
452