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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
BEGIN { $^W = 1; $| = 1; }
use strict;
use Test;
use Tk;
BEGIN { plan tests => 17 };
my $mw = Tk::MainWindow->new;
my $hlist;
{
eval { require Tk::HList; };
ok($@, "", 'Problem loading Tk::HList');
eval { $hlist = $mw->HList(); };
ok($@, "", 'Problem creating HList widget');
ok( Tk::Exists($hlist) );
eval { $hlist->grid; };
ok($@, "", '$hlist->grid problem');
eval { $hlist->update; };
ok($@, "", '$hlist->update problem.');
}
##
## With Tk800.004:
## 1) headerSize returns "x y" instead of [x,y].
## 2) Error headerSize err msg for non existant col contains garbage. E.g.
## Column "KC@" does not exist at ...
## 3) infoSelection not defined (test is just a bothering reminder to
## check all other Submethods that should be defined are defined).
## 4) entryconfigure -style contains garbage
##
{
my $hl = $mw->HList(-header=>1)->grid;
$hl->headerCreate(0, -text=>'a heading');
my @dim;
eval { @dim = $hl->headerSize(0); };
ok($@, '', "Problems with headerSize method");
ok(scalar(@dim), 2, 'headerSize returned not a 2 element array: |'.
join('|',@dim,'')
);
eval { $hlist->update; };
ok($@, "", '$hlist->update problem.');
eval { $hl->header('size', 1); }; # does not exist
ok($@ ne "", 1, "Oops, no error for non existent header field");
ok($@=~m/^Column "1" does not exist/, 1,
"'$@' does not match /^Column \"1\" does not exist/"
);
eval { $hlist->update; };
ok($@, "", '$hlist->update problem.');
eval { $hl->info('selection'); };
ok($@, "", "Problem with info('selection') method.");
eval { $hl->infoSelection; };
ok($@, "", "Problem with infoSelection method.");
eval { $hlist->update; };
ok($@, "", '$hlist->update problem.');
$hl->add(1,-text=>'one');
my $val1 = ( $hl->entryconfigure(1, '-style') )[4];
# comment out the next line and at least I get always a SEGV
ok(defined($val1), 1, "Ooops entryconfigure -style is not defined");
my $val2 = $hl->entrycget(1, '-style');
ok(defined($val2), 1, "Ooops entrycget -style is not defined");
ok($val1, $val2, "entryconfigure and entrycget do not agree");
$hl->destroy;
}
1;
__END__
|
