#!/usr/bin/perl
#
# $Id$
#
use strict;
use warnings;
#########################
# Gtk2 Tests
# - rm
#########################
#########################
# NOTE: this is the bootstrap test -- no Gtk2::TestHelper here!
use Test::More tests => 30;
BEGIN { use_ok('Gtk2') };
#########################
my @run_version = Gtk2->get_version_info;
my @compile_version = Gtk2->GET_VERSION_INFO;
diag 'Testing Gtk2 ', $Gtk2::VERSION;
diag ' Running against gtk+ ', join '.', @run_version;
diag ' Compiled against gtk+ ', join '.', @compile_version;
is( @run_version, 3, 'version info is three items long' );
is (Gtk2->check_version(0,0,0), 'Gtk+ version too new (major mismatch)',
'check_version pass');
is (Gtk2->check_version(50,0,0), 'Gtk+ version too old (major mismatch)',
'check_version fail');
ok (defined (Gtk2::major_version), 'major_version');
ok (defined (Gtk2::minor_version), 'minor_version');
ok (defined (Gtk2::micro_version), 'micro_version');
is (@compile_version, 3, 'version info is three items long');
ok (Gtk2->CHECK_VERSION(0,0,0), 'CHECK_VERSION pass');
ok (!Gtk2->CHECK_VERSION(50,0,0), 'CHECK_VERSION fail');
is (Gtk2::MAJOR_VERSION, $compile_version[0], 'MAJOR_VERSION');
is (Gtk2::MINOR_VERSION, $compile_version[1], 'MINOR_VERSION');
is (Gtk2::MICRO_VERSION, $compile_version[2], 'MICRO_VERSION');
#########################
SKIP:
{
Gtk2->disable_setlocale;
skip 'Gtk2->init_check failed, probably unable to open DISPLAY',
17, unless( Gtk2->init_check );
ok( Gtk2->init );
ok( Gtk2->set_locale );
isa_ok( Gtk2->get_default_language, "Gtk2::Pango::Language" );
is( Gtk2->main_level, 0, 'main level is zero when there are no loops' );
my $window = Gtk2::Object->new ("Gtk2::Window");
my $object = Gtk2::Object->new ("Gtk2::Label");
my $event = Gtk2::Gdk::Event->new ("button-press");
$event->button (1);
$event->time (time);
$event->state ([qw/shift-mask control-mask/]);
Gtk2::Gdk::Event->put ($event);
$window->add ($object);
$object->realize;
$object->propagate_event ($event);
# warn Gtk2->get_current_event;
# warn Gtk2->get_current_event_time;
# warn Gtk2->get_current_event_state;
# warn Gtk2->get_event_widget ($event);
my $events = 0;
my $retval;
while (Gtk2->events_pending) {
$retval = Gtk2->main_iteration;
$events++;
}
ok( $events );
ok( $retval );
Gtk2::Gdk::Event->put ($event);
$events = 0;
while (Gtk2->events_pending) {
$retval = Gtk2->main_iteration_do (0);
$events++;
}
ok( $events );
ok( $retval );
my $snooper;
ok( $snooper = Gtk2->key_snooper_install (sub { warn @_; 0; }, "bla") );
Gtk2->key_snooper_remove ($snooper);
Gtk2->init_add( sub { ok(1); } );
Gtk2->init_add( sub { ok($_[0] eq 'foo'); }, 'foo' );
ok(1);
Gtk2->quit_add_destroy (1, $object);
my $q1;
ok( $q1 = Gtk2->quit_add( 0, sub { Gtk2->quit_remove($q1); ok(1); } ) );
ok( Gtk2->quit_add( 0, sub { ok($_[0] eq 'bar'); }, 'bar' ) );
Glib::Idle->add( sub { Gtk2->main_quit; 0 } );
Gtk2->main;
ok(1);
}
__END__
Copyright (C) 2003-2004, 2013 by the gtk2-perl team (see the file AUTHORS for
the full list). See LICENSE for more information.