1#!/usr/bin/perl -w 2# -*- perl -*- 3 4# 5# Author: Slaven Rezic 6# 7 8use strict; 9 10use Tk; 11 12BEGIN { 13 if (!eval q{ 14 use Test::More; 15 1; 16 }) { 17 print "1..0 # skip: no Test::More module\n"; 18 exit; 19 } 20} 21 22plan tests => 16; 23 24if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 } 25 26my $mw = tkinit; 27$mw->geometry("+10+10"); 28 29use_ok("Tk::Table"); 30 31my $table = $mw->Table(-rows => 10, 32 -columns => 10, 33 -scrollbars => "se", 34 -fixedrows => 1, 35 -fixedcolumns => 1, 36 -takefocus => 1, 37 ); 38isa_ok($table, "Tk::Table"); 39$table->pack(qw(-fill both -expand 1)); 40 41$table->put(0,0,"Simple Label"); 42my $simple_label_w = $table->get(0,0); 43is($simple_label_w->cget("-text"), "Simple Label"); 44 45my $b = $table->Button(-text => "Simple Button"); 46$table->put(1,1,$b); 47is($table->get(1,1), $b); 48 49is($table->totalColumns, 2, "Number of occupied columns"); 50is($table->totalRows, 2, "Number of occupied rows"); 51 52$table->see(0,0); 53pass("See method works with coordinates"); 54$table->see($b); 55pass("See method works with widget"); 56 57my($b_row, $b_col) = $table->Posn($b); 58is($b_row, 1, "Row of Simple Button"); 59is($b_col, 1, "Column of Simple Button"); 60 61is($table->Subwidget("xscrollbar"), undef, 62 "Before update no scrollbars were created"); 63$table->update; 64isa_ok($table->Subwidget("xscrollbar"), "Tk::Scrollbar", 65 "x scrollbar"); 66isa_ok($table->Subwidget("yscrollbar"), "Tk::Scrollbar", 67 "y scrollbar"); 68 69{ 70 my $b2 = $table->Button(-text => "2nd button"); 71 $table->put(0,1,$b2); 72 is($table->get(0,1), $b2); 73 74 ok Tk::Exists($b2), 'Button exists before clear() method'; 75 $table->clear; 76 ok !Tk::Exists($b2), 'Button was destroyed by clear() method'; 77} 78 79if ($ENV{BATCH}) { 80 $mw->after(150, sub { $mw->destroy }); 81} 82 83MainLoop; 84 85__END__ 86