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

use strict;
use warnings;
use Test::More tests => 11;
use Scalar::Util 'weaken';

use_ok('X11::Xlib::XVisualInfo') or die;
sub err(&) { my $code= shift; my $ret; { local $@= ''; eval { $code->() }; $ret= $@; } $ret }

# Create a new XEvent
my $struct= new_ok( 'X11::Xlib::XVisualInfo', [], 'blank' );
ok( defined $struct->buffer, 'buffer is defined' );
ok( length($struct->buffer) > 0, 'and has non-zero length' );

my $struct2= bless \("x"x X11::Xlib::XVisualInfo->_sizeof), 'X11::Xlib::XVisualInfo';

$struct->red_mask(0xFF0000);
$struct->blue_mask(0x0000FF);

# Visual pointer should be wrapped in object, unless NULL, then undef
is( $struct->visual, undef, 'NULL visual is undef' );
isa_ok( $struct2->visual, 'X11::Xlib::Visual', 'non-null visual is object' );

# Clone an event via its fields:
X11::Xlib::_sanity_check_data_structures();
$struct->unpack;
$struct->unpack;
$struct->unpack;
my $clone= new_ok( 'X11::Xlib::XVisualInfo', [$struct->unpack], 'clone event with pack(unpack)' )
    or diag explain $struct->unpack;
is( $clone->buffer, $struct->buffer, 'clone contains identical bytes' );

is( $clone->red_mask, 0xFF0000, 'red_mask value preserved' );
is( $clone->blue_mask, 0x0000FF, 'blue_mask value preserved' );

subtest associated_with_display => sub {
    plan skip_all => "No X11 Server available"
        unless defined $ENV{DISPLAY};
    
    my $conn= X11::Xlib->new();
    ok( my @visuals= $conn->XGetVisualInfo(0, {}), 'XGetVisualInfo' );
    is( $visuals[0]->display, $conn, 'visual info related to display' );
    is( $visuals[0]->visual->display, $conn, 'visual from visualinfo also related to display' );
    
    weaken($conn);
    ok( $conn, 'un-ref connection, still alive' );
    undef @visuals;
    is( $conn, undef, 'visuals were holding last ref to conn' );
    
    done_testing;
};