1#!/usr/bin/perl -w 2# -*- perl -*- 3 4# 5# $Id: error.t,v 1.2 2008/02/08 22:30:43 eserte Exp $ 6# Author: Slaven Rezic 7# 8 9use strict; 10 11BEGIN { 12 if (!eval q{ 13 use Tk; 14 use Test::More; 15 use File::Temp qw(tempfile); 16 1; 17 }) { 18 print "1..0 # skip: no Tk, File::Temp and/or Test::More module\n"; 19 exit; 20 } 21 22 if ($^O eq 'MSWin32') { 23 print "1..0 # skip: Does not work under MSWin32, probably\n"; 24 exit; 25 } 26} 27 28use Tk::Getopt; 29 30plan tests => 4; 31 32my($fh, $file) = tempfile(UNLINK => 1); 33chmod 0000, $file; 34 35my %options; 36my $opt = Tk::Getopt->new(-opttable => [['test','=s','default']], 37 -options => \%options, 38 -filename => $file, 39 -useerrordialog => 1, 40 ); 41eval { $opt->save_options }; 42my($err) = $@ =~ /^(.*)/; 43ok($@, "Found error <$err>"); 44 45SKIP: { 46 my $mw = eval { tkinit }; 47 skip("Cannot create MainWindow", 3) 48 if !$mw; 49 $mw->geometry('+10+10'); # for twm 50 51 eval { $opt->save_options }; 52 ok($@, "Called within eval, still no window"); 53 54 $mw->after(300, sub { fire_dialog_button($mw) }); 55 $opt->save_options; 56 pass("Dialog destroyed, hopefully"); 57 58 my $opt_editor = $opt->option_editor($mw, -buttons => [qw/oksave cancel/]); 59 $mw->after(300, sub { 60 my $button; 61 my $abort = 0; 62 $mw->Walk(sub { 63 my $w = shift; 64 return if $abort; 65 if ($w->isa("Tk::Button") && $w->cget(-text) =~ /ok/i) { 66 $button = $w; 67 $abort = 1; 68 } 69 }); 70 if ($button) { 71 $mw->after(100, sub { fire_dialog_button($mw) }); 72 $button->invoke; 73 } else { 74 warn "No ok button found"; 75 } 76 }); 77 78 $mw->after(700, sub { $mw->destroy }); 79 MainLoop(); 80 81 pass("Dialog from oksave button destroyed, hopefully"); 82} 83 84sub fire_dialog_button { 85 my($mw) = @_; 86 my $button; 87 my $abort = 0; 88 $mw->Walk 89 (sub { 90 my($w) = @_; 91 return if $abort; 92 if ($w->isa("Tk::Dialog")) { 93 my $abort2 = 0; 94 $w->Walk 95 (sub { 96 return if $abort2; 97 if ($_[0]->isa("Tk::Button")) { 98 $button = $_[0]; 99 $abort2 = 1; 100 } 101 }); 102 $abort = 1; 103 } 104 }); 105 if ($button) { 106 $button->invoke; 107 } else { 108 diag "No dialog button found and clicked on"; 109 } 110} 111 112__END__ 113