perl-win32-gui-cvscommit

[Robert M. <rob...@us...>]

Update of /cvsroot/perl-win32-gui/Win32-GUI/t
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24631/t

Added Files:
	05_Timer_01_OEM.t 05_Timer_02_NEM.t 05_Timer_03_Interval.t 
	05_Timer_04_Kill.t 05_Timer_05_DESTROY.t 
Removed Files:
	05_Timer.t 
Log Message:
Bug fixes; re-work of WIn32::GUI::Timer; preparing for 1.03 release

--- NEW FILE: 05_Timer_04_Kill.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_04_Kill.t,v 1.1 2005/11/13 18:57:52 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(@_);
}


--- 05_Timer.t DELETED ---

--- NEW FILE: 05_Timer_01_OEM.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_01_OEM.t,v 1.1 2005/11/13 18:57:52 robertemay Exp $
#
# test coverage of Timers

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More tests => 14;

use Win32::GUI;

my $ctrl = "Timer";
my $class = "Win32::GUI::$ctrl";

my $elapse = 500; # ms

# Test the basic construction, and timing:

my @times;

my $t0 = time;

my $W = new Win32::GUI::Window(
    -name => "TestWindow",
);
isa_ok($W, "Win32::GUI::Window", "\$W");

my $C = $W->AddTimer('T1', $elapse);
isa_ok($C,$class, "\$W->AddTimer creats $class object");
isa_ok($W->T1, $class, "\$W->T1 contains a $class object");
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");

Win32::GUI::Dialog();

is(scalar(@times), 3, "Timer went off 3 times");

for my $interval (@times) {
	ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate");
}

sub T1_Timer
{
	my $t1 = time;
	push @times, ($t1 - $t0);
	$t0 = $t1;
	return scalar(@times) == 3 ? -1 : 0;
}

--- NEW FILE: 05_Timer_02_NEM.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_02_NEM.t,v 1.1 2005/11/13 18:57:52 robertemay Exp $
#
# test coverage of Timers

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More tests => 16;

use Win32::GUI;

my $ctrl = "Timer";
my $class = "Win32::GUI::$ctrl";

my $elapse = 500; # ms

# Test the basic construction, and timing:

my @times;
my %params;

my $t0 = time;

my $W = new Win32::GUI::Window(
    -name => "TestWindow",
    -onTimer => \&_process_timer,
);
isa_ok($W, "Win32::GUI::Window", "\$W");

my $C = $W->AddTimer('T1', $elapse);
isa_ok($C,$class, "\$W->AddTimer creats $class object");
isa_ok($W->T1, $class, "\$W->T1 contains a $class object");
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");

Win32::GUI::Dialog();

is(scalar(@times), 3, "Timer went off 3 times");

for my $interval (@times) {
	ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate");
}
@times=();

is($params{window}, $W, "Parent widow passed to NEM event handler");
is($params{name}, $C->{-name}, "timer name passed to NEM handler");
%params=();

sub _process_timer
{
	$params{window} = shift;
	$params{name} = shift;

	my $t1 = time;
	push @times, ($t1 - $t0);
	$t0 = $t1;
	return scalar(@times) == 3 ? -1 : 0;
}

--- NEW FILE: 05_Timer_05_DESTROY.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_05_DESTROY.t,v 1.1 2005/11/13 18:57:52 robertemay Exp $
#
# test coverage of Timers

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More tests => 11;

use Win32::GUI;

my $ctrl = "Timer";
my $class = "Test::$ctrl";

my $elapse = 500; # ms

# Test DESTRUCTION
{
	my $W = new Win32::GUI::Window(
	    -name => "TestWindow",
	);
	my $C = Test::Timer->new($W, 'T1', $elapse);

	# DESTROY tests
	is($Test::Timer::x, 0, "DESTROY not called yet");
	undef $C; # should still be a reference from the parent object
	is($Test::Timer::x, 0, "DESTROY not called yet");
	undef $W; # should reduce ref count to parent to zero, and in turn Timer
	is($Test::Timer::x, 1, "DESTROY called when parent destroyed");
}

{
	my $W = new Win32::GUI::Window(
	    -name => "TestWindow",
	);
	my $C = Test::Timer->new($W, 'T1', $elapse);

	my $id = $C->{-id};
	ok(defined $W->{-timers}->{$id}, "Timer's id is stored in parent");
	is($C, $W->T1, "Reference sotered in Parent");
	
	# DESTROY tests
	$Test::Timer::x = 0;
	is($Test::Timer::x, 0, "DESTROY not called yet");
	undef $C; # should still be a reference from the parent object
	is($Test::Timer::x, 0, "DESTROY not called yet");
	$W->{T1} = undef; # naughty way to remove timer
	is($Test::Timer::x, 1, "DESTROY called when parent reference removed");
	ok(!defined $W->{-timers}->{$id}, "DESTROY() tidies parent");
	ok(!defined $W->{T1}, "DESTROY() tidies parent");
	undef $W;
	is($Test::Timer::x, 1, "DESTROY not called when parent destroyed");
}

package Test::Timer;
our (@ISA, $x);

BEGIN {
	@ISA = qw(Win32::GUI::Timer);
	$x = 0;
}

sub DESTROY
{
	++$x;
	shift->SUPER::DESTROY();
}


--- NEW FILE: 05_Timer_03_Interval.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_Timer_03_Interval.t,v 1.1 2005/11/13 18:57:52 robertemay Exp $
#
# test coverage of Timers

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More tests => 11;

use Win32::GUI;

my $ctrl = "Timer";
my $class = "Win32::GUI::$ctrl";

my $elapse = 500; # ms

# Test the basic construction, and timing:

my @times;

my $t0 = time;

my $W = new Win32::GUI::Window(
    -name => "TestWindow",
    -onTimer => \&_process_timer,
);
my $C = $W->AddTimer('T1', $elapse);

is($C->Interval(), $elapse, "Interval() returns timer interval");

@times=();
Win32::GUI::Dialog();

is(scalar(@times), 3, "Timer went off 3 times");
for my $interval (@times) {
	ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate");
}

is($C->Interval($elapse+500), $elapse, "Interval(SET) returns prior timer interval");
is($C->Interval(), $elapse+500, "Interval() returns new timer interval");

@times=();
Win32::GUI::Dialog();

is(scalar(@times), 3, "Timer went off 3 times");
for my $interval (@times) {
	ok(($interval <= 2) && ($interval >= 0), "Timer interval(${interval}s) appropriate");
}

sub _process_timer
{
	my $t1 = time;
	push @times, ($t1 - $t0);
	$t0 = $t1;
	return scalar(@times) == 3 ? -1 : 0;
}