← Back to branch summary

~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to t/wm-time.t

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
http://bugs.debian.org/237942
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/wm-time.t
 
1
#!/usr/bin/perl -w
 
2
# -*- perl -*-
 
3
 
 
4
use strict;
 
5
use Tk;
 
6
use Test::More;
 
7
plan tests => 12;
 
8
 
 
9
my $event = '<Visibility>';
 
10
my $why;
 
11
my $start;
 
12
 
 
13
sub begin
 
14
{
 
15
 $start = Tk::timeofday();
 
16
 $why = shift;
 
17
}
 
18
 
 
19
my $mw = new MainWindow;
 
20
my $l = $mw->Label(-text => 'Content')->pack;
 
21
#$l->bind($event,[\&mapped,"update"]);
 
22
$mw->bind($event,[\&mapped,"update"]);
 
23
$mw->geometry("+0+0");
 
24
begin('update');
 
25
$mw->update;
 
26
 
 
27
my $t = $mw->Toplevel(-width => 100, -height => 100);
 
28
my $l2 = $t->Label(-text => 'Content')->pack;
 
29
$t->bind($event,[\&mapped,"Popup"]);
 
30
#$l2->bind($event,[\&mapped,"Popup"]);
 
31
begin('Popup');
 
32
$t->Popup(-popover => $mw);
 
33
$t->update;
 
34
begin('withdraw');
 
35
$t->withdraw;
 
36
begin('Popup Again');
 
37
$t->Popup(-popover => $mw);
 
38
 
 
39
$mw->after(1000, sub { begin('destroy'); $mw->destroy });
 
40
 
 
41
MainLoop;
 
42
 
 
43
 
 
44
sub mapped
 
45
{
 
46
 my ($w) = @_;
 
47
 my $now = Tk::timeofday();
 
48
 my $delay = $now - $start;
 
49
 printf "# %s $why %.3g\n",$w->PathName,$delay;
 
50
 ok($delay < 0.5,$why);
 
51
}
 
52
 
 
53
 
 
54
 
 
55
 
 
56