# -*- 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__