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