#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_04_Kill.t,v 1.2 2006/05/16 18:57:26 robertemay Exp $
#
# test coverage of Timers
use strict;
use warnings;
BEGIN { $| = 1 } # Autoflush
use Test::More tests => 19;
use Win32::GUI();
my $ctrl = "Timer";
my $class = "Test::$ctrl";
my $elapse = 500; # ms
# Test the Kill method
my $W = new Win32::GUI::Window(
-name => "TestWindow",
);
my $C = Test::Timer->new($W, 'T1', $elapse);
isa_ok($C,$class, "new creates $class object");
isa_ok($C,"Win32::GUI::Timer", "$class is a subclass of Win32::GUI::Timer");
isa_ok($W->T1, $class, "\$W->T1 contains a $class object");
isa_ok($W->T1,"Win32::GUI::Timer", "\$W->T1 contains a subclass of Win32::GUI::Timer");
is($C, $W->T1, "Parent references $ctrl");
my $id = $C->{-id};
ok(($id > 0), "timer's -id > 0");
ok(defined $W->{-timers}->{$id}, "Timer's id is stored in parent");
is($W->{-timers}->{$id}, 'T1', "Timer's name is stored in parent");
is($C->{-name}, 'T1', "Timer's name is stored in timer object");
is($C->{-handle}, $W->{-handle}, "Parent's handle is stored in timer object");
is($C->{-interval}, $elapse, "Timer interval is stored in timer object");
# Kill tests
is($C->Kill(), $elapse, "Kill() returns timer interval");
is($C->Interval(), 0, "Kill() sets inteval to zero");
is($Test::Timer::x, 0, "DESTROY not called yet");
ok(!defined($C->Kill(1)), "Kill(1) returns undef");
is($Test::Timer::x, 1, "Kill(1) calls DESTROY");
ok(!defined $W->{-timers}->{$id}, "Kill(1) tidies parent");
ok(!defined $W->{T1}, "Kill(1) tidies parent");
undef $C; #should remove last reference
is($Test::Timer::x, 2, "DESTROY called for object destruction");
package Test::Timer;
our (@ISA, $x);
BEGIN {
@ISA = qw(Win32::GUI::Timer);
$x = 0;
}
sub DESTROY
{
my $self = shift;
++$x;
$self->SUPER::DESTROY(@_);
}