The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2012, 2013 Kevin Ryde

# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other.  If not, see <http://www.gnu.org/licenses/>.

BEGIN { require 5 }
use strict;
use X11::Protocol;
use Test;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings() }
END { MyTestHelpers::diag ("END"); }

# uncomment this to run the ### lines
# use Smart::Comments;

my $test_count = (tests => 158)[1];
plan tests => $test_count;

require X11::Protocol;
MyTestHelpers::diag ("X11::Protocol version ", X11::Protocol->VERSION);

my $display = $ENV{'DISPLAY'};
if (! defined $display) {
  foreach (1 .. $test_count) {
    skip ('No DISPLAY set', 1, 1);
  }
  exit 0;
}

# pass display arg so as not to get a "guess" warning
my $X;
if (! eval { $X = X11::Protocol->new ($display); }) {
  MyTestHelpers::diag ('Cannot connect to X server -- ',$@);
  foreach (1 .. $test_count) {
    skip ('Cannot connect to X server', 1, 1);
  }
  exit 0;
}
$X->QueryPointer($X->{'root'});  # sync

my ($major_opcode, $first_event, $first_error)
  = $X->QueryExtension('SYNC');
{
  if (! defined $major_opcode) {
    foreach (1 .. $test_count) {
      skip ('QueryExtension() no SYNC on the server', 1, 1);
    }
    exit 0;
  }
  MyTestHelpers::diag ("SYNC extension opcode=$major_opcode event=$first_event error=$first_error");
}

if (! $X->init_extension ('SYNC')) {
  die "QueryExtension says SYNC avaiable, but init_extension() failed";
}
$X->QueryPointer($X->root); # sync


#------------------------------------------------------------------------------
# Helpers.

# Return $b << $n, with $b converted to a Math::BigInt for the shift.
# No "<<" operator in old Math::BigInt, so this is implemented with "**".
sub big_leftshift {
  my ($b, $n) = @_;
  require Math::BigInt;
  return Math::BigInt->new("$b") * Math::BigInt->new(2) ** $n;
}


#------------------------------------------------------------------------------
# _hilo_to_int64()
# Note explicit stringizing to cope with old Math::BigInt.

MyTestHelpers::diag ("_INT_BITS() is ", X11::Protocol::Ext::SYNC::_INT_BITS());

{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,1);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret == 1, 1);
}
{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,0x8000_0000);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret, '2147483648');
}
{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0,0xFFFF_FFFF);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret, '4294967295');
}
{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0x8000_0000,3);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret, '-9223372036854775805');
}
{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0x1234_5678, 0x8765_4321);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret, '1311768467139281697');
}
{ my $ret = X11::Protocol::Ext::SYNC::_hilo_to_int64(0xFFFF_FFFF, 0xFFFF_FFFF);
  $ret = "$ret";
  $ret =~ s/^\+//;
  ok ($ret == -1, 1);
}

#------------------------------------------------------------------------------
# _int64_to_hilo()

{ my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo(0);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 0, 1);
  ok ($ret[1] == 0, 1);
}
{ my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo(-1);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 0xFFFF_FFFF, 1);
  ok ($ret[1] == 0xFFFF_FFFF, 1);
}
{ my $sv = big_leftshift(1,32);
  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 1, 1);
  ok ($ret[1] == 0, 1);
}
{ my $sv = big_leftshift(1,63) - 1;
  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 0x7FFF_FFFF, 1);
  ok ($ret[1] == 0xFFFF_FFFF, 1);
}
{ # -8000_0000 0000_0000
  my $sv = - big_leftshift(1,63);
  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 0x8000_0000, 1,  "-800..00 hi got $ret[0]");
  ok ($ret[1] == 0,           1);
}
{ # -4000_0000 0000_0001
  my $sv = - big_leftshift(1,62) - 1;
  my ($hi,$lo) = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
  ok ($hi == 0xBFFF_FFFF, 1);
  ok ($lo == 0xFFFF_FFFF, 1);
}

{
  # -7FFF_FFFF FFFF_FFFF
  my $sv = - big_leftshift(1,63) + 1;
  my @ret = X11::Protocol::Ext::SYNC::_int64_to_hilo($sv);
  ok (scalar(@ret), 2);
  ok ($ret[0] == 0x8000_0000, 1,  "-7FF..FF hi got $ret[0]");
  ok ($ret[1] == 1,           1,  "-7FF..FF lo want 1 got $ret[0]");
  MyTestHelpers::diag ("sv=$sv   hi=$ret[0] lo=$ret[1]");
}

#------------------------------------------------------------------------------
# errors

{
  ok ($X->num('Error','Counter'),    $first_error);
  ok ($X->num('Error','Alarm'),      $first_error+1);
  ok ($X->num('Error',$first_error),   $first_error);
  ok ($X->num('Error',$first_error+1), $first_error+1);
  ok ($X->interp('Error',$first_error),   'Counter');
  ok ($X->interp('Error',$first_error+1), 'Alarm');
  {
    local $X->{'do_interp'} = 0;
    ok ($X->interp('Error',$first_error), $first_error);
    ok ($X->interp('Error',$first_error+1), $first_error+1);
  }
}


#------------------------------------------------------------------------------
# SyncTestType enum

ok ($X->num('SyncTestType','PositiveTransition'),   0);
ok ($X->num('SyncTestType','NegativeTransition'),   1);
ok ($X->num('SyncTestType','PositiveComparison'),   2);
ok ($X->num('SyncTestType','NegativeComparison'),   3);

ok ($X->interp('SyncTestType',0), 'PositiveTransition');
ok ($X->interp('SyncTestType',1), 'NegativeTransition');
ok ($X->interp('SyncTestType',2), 'PositiveComparison');
ok ($X->interp('SyncTestType',3), 'NegativeComparison');


#------------------------------------------------------------------------------
# SyncValueType enum

ok ($X->num('SyncValueType','Absolute'),   0);
ok ($X->num('SyncValueType','Relative'),   1);

ok ($X->interp('SyncValueType',0), 'Absolute');
ok ($X->interp('SyncValueType',1), 'Relative');


#------------------------------------------------------------------------------
# SyncAlarmState enum

ok ($X->num('SyncAlarmState','Active'),    0);
ok ($X->num('SyncAlarmState','Inactive'),  1);
ok ($X->num('SyncAlarmState','Destroyed'), 2);

ok ($X->interp('SyncAlarmState',0), 'Active');
ok ($X->interp('SyncAlarmState',1), 'Inactive');
ok ($X->interp('SyncAlarmState',2), 'Destroyed');


#------------------------------------------------------------------------------
# SyncCreateCounter / SyncDestroyCounter

{
  my $counter = $X->new_rsrc;
  $X->SyncCreateCounter ($counter, 123);
  $X->QueryPointer($X->root); # sync
  ok (1, 1, 'SyncCreateCounter');

  { my $value = $X->SyncQueryCounter ($counter);
    $value = "$value";
    $value =~ s/^\+//;
    ok ($value, 123);
  }

  { my $value;
    foreach $value (0, 1, -1,
                    big_leftshift(1,32),
                    - big_leftshift(1,32),
                    big_leftshift(1,63) - 1,
                    - big_leftshift(1,63),
                   ) {
      $X->SyncSetCounter ($counter, $value);
      my $got_value = $X->SyncQueryCounter ($counter);
      ok ($got_value == $value, 1,
          "counter $value got $got_value");
    }
  }

  $X->SyncDestroyCounter ($counter);
  $X->QueryPointer($X->root); # sync
  ok (1, 1, 'SyncDestroyCounter');
}

#------------------------------------------------------------------------------
# SyncCreateAlarm / SyncDestroyAlarm

{
  my $alarm = $X->new_rsrc;
  $X->SyncCreateAlarm ($alarm);

  $X->SyncDestroyAlarm ($alarm);
  $X->QueryPointer($X->root); # sync
  ok (1, 1, 'SyncCreateAlarm / SyncDestroyAlarm');
}

#------------------------------------------------------------------------------
# alarm parameters

{
  my $counter = $X->new_rsrc;
  $X->SyncCreateCounter ($counter, 123);
  my $alarm = $X->new_rsrc;
  $X->SyncCreateAlarm ($alarm, value => -123);

  { my %h = $X->SyncQueryAlarm ($alarm);
    ok ($h{'value'} == -123,                     1);
    ok ($h{'test_type'} eq 'PositiveComparison', 1);
    ok ($h{'value_type'} eq 'Absolute',          1);
    ok ($h{'delta'} == 1,          1);
    ok ($h{'events'} == 1,         1);
    ok ($h{'state'} eq 'Inactive', 1);

    # print $h{'delta'},"\n";
    # use Devel::Peek;
    # Dump($h{'delta'});
  }

  {
    $X->SyncChangeAlarm ($alarm,
                         test_type => 'NegativeComparison',
                         delta => -1);
    my %h = $X->SyncQueryAlarm ($alarm);
    ok ($h{'test_type'}, 'NegativeComparison');
    ok ($h{'delta'} == -1, 1);
  }
  {
    $X->SyncChangeAlarm ($alarm,
                         counter    => $counter,
                         value_type => 'Relative');
    my %h = $X->SyncQueryAlarm ($alarm);
    ok ($h{'counter'}, $counter);
  }
  {
    $X->SyncChangeAlarm ($alarm, value_type => 'Absolute');
    my %h = $X->SyncQueryAlarm ($alarm);
    ok ($h{'value_type'}, 'Absolute');
    ok ($h{'events'}, 1);
  }
  {
    $X->SyncChangeAlarm ($alarm, events => 0);
    my %h = $X->SyncQueryAlarm ($alarm);
    ok ($h{'events'}, 0);
  }

  $X->SyncDestroyAlarm ($alarm);
  $X->SyncDestroyCounter ($counter);
  $X->QueryPointer($X->root); # sync
}

#------------------------------------------------------------------------------
# SyncCounterNotify event

{
  my $aref = $X->{'ext'}->{'SYNC'};
  my ($request_num, $event_num, $error_num, $obj) = @$aref;

  my $more;
  foreach $more (0, 1) {
    my $time;
    foreach $time ('CurrentTime', 103) {
      my %input = (# can't use "name" on an extension event, in
                   # X11::Protocol 0.56
                   # name        => "SyncCounterNotify",
                   synthetic     => 1,
                   code          => $event_num,
                   sequence_number => 100,

                   counter       => 101,
                   wait_value    => -123,
                   counter_value => -256,
                   time          => $time,
                   count         => 6,
                   destroyed     => 1,
                  );
      my $data = $X->pack_event(%input);
      ok (length($data), 32);

      my %output = $X->unpack_event($data);
      ### %output

      ok ($output{'code'},      $input{'code'});
      ok ($output{'name'},      'SyncCounterNotify');
      ok ($output{'synthetic'}, $input{'synthetic'});

      ok ($output{'counter'},      $input{'counter'});
      ok ($output{'wait_value'},   $input{'wait_value'});
      ok ($output{'counter_value'},$input{'counter_value'});
      ok ($output{'time'},         $input{'time'});
      ok ($output{'count'},        $input{'count'});
      ok ($output{'destroyed'},    $input{'destroyed'});
    }
  }
}

#------------------------------------------------------------------------------
# SyncAlarmNotify event

{
  my $aref = $X->{'ext'}->{'SYNC'};
  my ($request_num, $event_num, $error_num, $obj) = @$aref;
  my $alarm_event_num = $event_num + 1;

  my $more;
  foreach $more (0, 1) {
    my $time;
    foreach $time ('CurrentTime', 103) {
      my %input = (# can't use "name" on an extension event, in
                   # X11::Protocol 0.56
                   # name          => "SyncAlarmNotify",
                   synthetic       => 1,
                   code            => $alarm_event_num,
                   sequence_number => 100,

                   alarm         => 101,
                   counter_value => -123,
                   alarm_value   => -256,
                   time          => $time,
                   state         => 'Destroyed',
                  );
      my $data = $X->pack_event(%input);
      ok (length($data), 32);

      my %output = $X->unpack_event($data);
      ### %output

      ok ($output{'code'},      $input{'code'});
      ok ($output{'name'},      'SyncAlarmNotify');
      ok ($output{'synthetic'}, $input{'synthetic'});

      ok ($output{'alarm'},         $input{'alarm'});
      ok ($output{'counter_value'}, $input{'counter_value'});
      ok ($output{'alarm_value'},   $input{'alarm_value'});
      ok ($output{'time'},          $input{'time'});
      ok ($output{'state'},         $input{'state'});
    }
  }
}


#------------------------------------------------------------------------------
# SyncSetPriority / SyncGetPriority

{
  $X->SyncSetPriority(0,123);
  ok ($X->SyncGetPriority(0), 123);

  $X->SyncSetPriority("None",-123);
  ok ($X->SyncGetPriority(0), -123);

  $X->SyncSetPriority(0,0);
  ok ($X->SyncGetPriority(0), 0);

  # second client connection
  my $X2 = X11::Protocol->new ($display);
  my $pixmap2 = $X2->new_rsrc;
  $X2->CreatePixmap($pixmap2, $X2->root, 1, 1,1);
  $X2->QueryPointer($X->root); # sync

  $X->SyncSetPriority($pixmap2, 456);
  ok ($X->SyncGetPriority($pixmap2), 456);
  ok ($X2->SyncGetPriority(0), 456);
  ok ($X->SyncGetPriority(0), 0);

  my $pixmap = $X->new_rsrc;
  $X->CreatePixmap($pixmap, $X2->root, 1, 1,1);
  ok ($X->SyncGetPriority($pixmap), 0);
  $X->FreePixmap($pixmap);
}


#------------------------------------------------------------------------------

exit 0;