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