File: zzTixGrid.t

package info (click to toggle)
perl-tk 1%3A800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (111 lines) | stat: -rw-r--r-- 4,527 bytes parent folder | download | duplicates (11)
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
# -*- perl -*-
BEGIN { $^W=1; $|=1; }

use strict;
use Test;
use Tk;

BEGIN { plan tests => 33,
#       todo => [18,26,32]
      };

my $mw = Tk::MainWindow->new;
eval { $mw->geometry('+10+10'); };  # This works for mwm and interactivePlacement

my $tixgrid;
{
   eval { require Tk::TixGrid; };
   ok($@, "", 'Problem loading Tk::TixGrid');
   eval { $tixgrid = $mw->TixGrid(); };
   ok($@, "", 'Problem creating TixGrid widget');
   ok( Tk::Exists($tixgrid) );
   eval { $tixgrid->grid; };
   ok($@, "", '$tixgrid->grid problem');
}
##
## TixGrid->nearest gives always a 'TCL panic' if tixgrid is visible in Tk800.003
##
## ptksh> p $tg->nearest(10,10)
## No results
## Tcl_Panic at (eval 7) line 1.
##
{
    my @entry;
    eval { @entry = $tixgrid->nearest(10,10); };  # there should be no entry
    ok($@ eq "");
    ok(
	scalar(@entry),
	0,
        "nearest returned array of size " . @entry . " instead of 0. " .
    	join('|','@entry=', @entry,'')
    );

    ## Make widget visible, nearest -> SEGV
    $tixgrid->update;
    eval { @entry = $tixgrid->nearest(10,10); };  # there should be no entry
    ok($@ eq "");

}
##
## Tk800.004: selectionSet ignores -selectunit
## selectionClear also does not work.
##
{
    my $g = $mw->TixGrid->grid;

    # populate
    eval
      {
        for my $x (0..10)
          {
	    for my $y (0..10)
              {
	        $g->set($x,$y, -itemtype=>'text', -text=>"($x,$y)" );
	      }
          }
      };
    ok($@, "", "Problem populate TixGrid with items");

    my $b = '';

    # test column selection
    eval { $g->configure(-selectunit=>'column'); };   ok($@, "", "Problem col configure -selectunit=>column");
    eval { $g->selection('set', 1,1); };              ok($@, "", "problem col set selection");
    eval { $b=$g->selection('includes', 1,1); };      ok($@, "", "problem selection includes");
    eval { $g->update; };                             ok($@, "", "problem col update");

    eval { $b=$g->selection('includes', 1,1); };      ok($@, "", "problem selection includes");
    ok($b, 1,  "oops col selection does not contain the item");
    eval { $b=$g->selection('includes', 1,0=>1,10);}; ok($b, 1,  "oops col selection does not contain the col");
    eval { $g->update; };                             ok($@, "", "problem col update");

    eval { $g->selectionClear(1,5); };                ok($@, "", "problem col sel clear");
#   eval { $b=$g->selection('includes', 1,1); };      ok($b, "",  "oops col selection is not cleared");

    # test row selection
    eval { $g->configure(-selectunit=>'row'); };      ok($@, "", "Problem row configure -selectunit=>row");
    eval { $g->selection('set', 2,2); };              ok($@, "", "problem row set selection");
    eval { $g->update; };                             ok($@, "", "problem row update");
    eval { $b=$g->selection('includes',2,2); };       ok($b, 1,  "oops row selection does not contain the item");
    eval { $b=$g->selection('includes',0,2=>10,2); }; ok($b, 1,  "oops row selection does not contain the row");
    eval { $g->update; };                             ok($@, "", "problem row update");
    eval { $g->selectionClear(5,2); };                ok($@, "", "problem row sel clear");
#   eval { $b=$g->selection('includes', 2,2); };      ok($b, "",  "oops row selection is not cleared");

    # test cell selection
    eval { $g->configure(-selectunit=>'cell'); };     ok($@, "", "Problem cell configure -selectunit=>cell");
    eval { $g->selection('set', 3,3); };              ok($@, "", "problem cell set selection");
    eval { $b=$g->update; };                          ok($@, "", "problem cell update");
    eval { $b=$g->selection('includes', 3,3); };      ok($b, 1,  "oops cell selection does not contain the item");
    eval { $b=$g->selection('includes', 2,3); };      ok($b, 0, "oops cell selection contain a not selected item");
#   eval { $b=$g->selection('includes', 2,2); };      ok($b, 0, "oops cell selection contain a not selected item");
    eval { $b=$g->selection('includes', 4,3); };      ok($b, 0, "oops cell selection contain a not selected item");
    eval { $b=$g->selection('includes', 3,4); };      ok($b, 0, "oops cell selection contain a not selected item");
    eval { $g->update; };                             ok($@, "", "problem cell update");
    eval { $g->selectionClear(3,3); };                ok($@, "", "problem cell sel clear");
#   eval { $b=$g->selection('includes', 3,3); };      ok($b, 0, "oops cell selection not cleared");
}

1;
__END__