← Back to branch summary

~ubuntu-branches/ubuntu/raring/perl-tk/raring

« back to all changes in this revision

Viewing changes to t/zzHList.t

  • Committer: Bazaar Package Importer
  • Author(s): Colin Tuckley
  • Date: 2008-02-15 13:56:59 UTC
  • mfrom: (1.1.3 upstream) (4.1.1 hardy)
  • Revision ID: james.westby@ubuntu.com-20080215135659-ru2oqlykuju20fav
Tags: 1:804.028-1
http://bugs.debian.org/463080
http://bugs.debian.org/411129
* New Upstream Release (Closes: #463080).
* Update to Debhelper v5.
* Build with XFT=1 (Closes: #411129).

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/zzHList.t
2
2
BEGIN { $^W = 1; $| = 1; }
3
3
 
4
4
use strict;
5
 
use Test;
6
5
use Tk;
7
6
 
8
 
BEGIN { plan tests => 23 };
 
7
BEGIN {
 
8
    if (!eval q{
 
9
        use Test::More;
 
10
        1;
 
11
    }) {
 
12
        print "1..0 # skip: no Test::More module\n";
 
13
        exit;
 
14
    }
 
15
}
 
16
 
 
17
plan tests => 29;
9
18
 
10
19
my $mw = Tk::MainWindow->new;
11
20
eval { $mw->geometry('+10+10'); };  # This works for mwm and interactivePlacement
13
22
my $hlist;
14
23
{
15
24
   eval { require Tk::HList; };
16
 
   ok($@, "", 'Problem loading Tk::HList');
 
25
   is($@, "", 'Loading Tk::HList');
17
26
   eval { $hlist = $mw->HList(); };
18
 
   ok($@, "", 'Problem creating HList widget');
 
27
   is($@, "", 'Creating HList widget');
19
28
   ok( Tk::Exists($hlist) );
20
29
   eval { $hlist->grid; };
21
 
   ok($@, "", '$hlist->grid problem');
 
30
   is($@, "", '$hlist->grid');
22
31
   eval { $hlist->update; };
23
 
   ok($@, "", '$hlist->update problem.');
 
32
   is($@, "", '$hlist->update.');
24
33
 
25
34
   $hlist->delete("all");
26
35
   $hlist->add("entry with spaces");
27
36
   my @bbox = $hlist->info('bbox', 'entry with spaces');
28
37
   my @info = $hlist->info('item', @bbox[0, 1]);
29
 
   ok($info[0], 'entry with spaces', 'Problems with spaces in entry path');
 
38
   is($info[0], 'entry with spaces', 'Spaces in entry path');
30
39
}
31
40
##
32
41
## With Tk800.004:
43
52
 
44
53
    my @dim;
45
54
    eval { @dim = $hl->headerSize(0); };
46
 
    ok($@, '', "Problems with headerSize method");
47
 
    ok(scalar(@dim), 2, 'headerSize returned not a 2 element array: |'.
48
 
        join('|',@dim,'')
49
 
        );
 
55
    is($@, '', "headerSize method");
 
56
    is(scalar(@dim), 2, 'headerSize returned a 2 element array: |'.
 
57
       join('|',@dim,'')
 
58
      );
50
59
    eval { $hlist->update; };
51
 
    ok($@, "", '$hlist->update problem.');
 
60
    is($@, "", '$hlist->update.');
52
61
 
53
62
    eval { $hl->header('size', 1); }; # does not exist
54
 
    ok($@ ne "", 1, "Oops, no error for non existent header field");
55
 
    ok($@=~m/^Column "1" does not exist/, 1,
56
 
        "'$@' does not match /^Column \"1\" does not exist/"
 
63
    isnt($@, "", "Error for non existent header field");
 
64
    like($@, qr/^Column "1" does not exist/,
 
65
         "Error message matches /^Column \"1\" does not exist/"
57
66
        );
58
67
    eval { $hlist->update; };
59
 
    ok($@, "", '$hlist->update problem.');
 
68
    is($@, "", '$hlist->update.');
60
69
 
61
70
    eval { $hl->info('selection'); };
62
 
    ok($@, "", "Problem with info('selection') method.");
 
71
    is($@, "", "info('selection') method.");
63
72
    eval { $hl->infoSelection; };
64
 
    ok($@, "", "Problem with infoSelection method.");
 
73
    is($@, "", "infoSelection method.");
65
74
    eval { $hlist->update; };
66
 
    ok($@, "", '$hlist->update problem.');
 
75
    is($@, "", '$hlist->update.');
67
76
 
68
77
    $hl->add(1,-text=>'one');
69
78
    my $val1 = ( $hl->entryconfigure(1, '-style') )[4];
70
79
    # comment out the next line and at least I get always a SEGV
71
 
    ok(!defined($val1), 1, "Ooops entryconfigure -style is defined");
 
80
    isnt(defined($val1), "entryconfigure -style is not defined");
72
81
    my $val2 = $hl->entrycget(1, '-style');
73
 
    ok(!defined($val2), 1, "Ooops entrycget -style is defined");
 
82
    isnt(defined($val2), "entrycget -style is not defined");
74
83
    # ok($val1, $val2, "entryconfigure and entrycget do not agree");
75
84
 
76
85
    my @bbox = $hl->infoBbox(1);
77
 
    ok(scalar(@bbox), 4, "\@bbox not 4 items");
 
86
    is(scalar(@bbox), 4, "\@bbox 4 items");
78
87
    my $bbox = $hl->infoBbox(1);
79
 
    ok(ref($bbox), 'ARRAY', "$bbox not an ARRAY");
 
88
    is(ref($bbox), 'ARRAY', "$bbox is an ARRAY");
80
89
    foreach my $a (@bbox)
81
90
     {
82
 
      ok($a, shift(@$bbox), "\$bbox values differ");
 
91
      is($a, shift(@$bbox), "\$bbox values OK");
83
92
     }
84
93
    $hl->destroy;
85
94
}
86
95
 
 
96
SKIP: {
 
97
    skip("Aborts with Tk804", 1)
 
98
        if $Tk::VERSION <= 804.027;
 
99
 
 
100
    my $hl = $mw->HList;
 
101
 
 
102
    $hl->add("top", -text => "top");
 
103
    $hl->add("top.item1", -text => "item1");
 
104
    $hl->add("top.item2", -text => "item2");
 
105
 
 
106
    $hl->add("top.item3", -at => 0, -text => "item2");
 
107
    $hl->add("top.item4", -before => "top.item1", -text => "item2");
 
108
    $hl->add("top.item5", -after => "top.item1", -text => "item2");
 
109
 
 
110
    pass("No abort with -at/-before/-after");
 
111
 
 
112
    $hl->destroy;
 
113
}
 
114
 
 
115
{
 
116
    my $hl = $mw->HList;
 
117
 
 
118
    $hl->add("top", -text => "top");
 
119
    $hl->add("top.item1", -text => "item1");
 
120
    $hl->add("top.item2", -text => "item2");
 
121
 
 
122
    ok(!$hl->info('hidden', 'top.item1'), "Item initially not hidden");
 
123
    $hl->hide('entry','top.item1');
 
124
    ok($hl->info('hidden', 'top.item1'), "Item now hidden");
 
125
    $hl->show('entry','top.item1');
 
126
    ok(!$hl->info('hidden', 'top.item1'), "Item not hidden again");
 
127
    $hl->hideEntry('top.item1');
 
128
    ok($hl->info('hidden', 'top.item1'), "Undocumented method hideEntry also works");
 
129
 
 
130
    $hl->destroy;
 
131
}
 
132
 
 
133
{
 
134
    my $hl = $mw->HList;
 
135
    $hl->addchild("");
 
136
    pass("addchild with empty string");
 
137
}
 
138
 
87
139
1;
88
140
__END__
89
141