File: progbar.t

package info (click to toggle)
perl-tk 1%3A804.027-7
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 30,204 kB
  • ctags: 33,761
  • sloc: ansic: 340,354; perl: 44,606; sh: 8,869; makefile: 5,658; asm: 996; yacc: 883; cpp: 570; pascal: 536
file content (30 lines) | stat: -rw-r--r-- 613 bytes parent folder | download | duplicates (2) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
BEGIN { $^W = 1; $| = 1;}
use strict;
use Test;
use Tk;
use Tk::widgets qw(ProgressBar);

plan tests => 15;

my $mw  = MainWindow->new();
$mw->geometry('+100+100');

my $var = 0;

my $pb  = $mw->ProgressBar(-bd => 3, -relief => 'raised', -fg => 'blue', -variable => \$var)->pack;
ok(defined($pb),1,"Cannot create");

ok(defined(tied($var)),1,"Variable not tied");
ok($pb->cget('-from'),0,"Bad from");
ok($pb->cget('-to'),100,"Bad to");

for my $v (map(10*$_+3,1..10))
 {
  $var = $v;
  ok($pb->cget('-value'),$v,"Value not $v");
  $mw->update;
 }

$mw->destroy;
ok(defined(tied($var)),'',"Variable still tied");