← Back to branch summary

~ubuntu-branches/ubuntu/maverick/perl-tk/maverick

« back to all changes in this revision

Viewing changes to t/fbox.t

  • Committer: Bazaar Package Importer
  • Author(s): Colin Tuckley
  • Date: 2010-05-30 09:19:40 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20100530091940-wbmq9bloo92t9m6x
Tags: 1:804.029-1
http://bugs.debian.org/578814
* New Upstream Release (Closes: #578814).
* Added debian/watch file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/fbox.t
14
14
    }
15
15
}
16
16
 
 
17
use Getopt::Long;
 
18
 
17
19
use TkTest qw(catch_grabs);
18
20
 
19
 
plan tests => 13;
 
21
plan tests => 15;
20
22
 
21
23
if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 }
22
24
 
30
32
 
31
33
my $delay = 500;
32
34
 
 
35
GetOptions("delay=i" => \$delay)
 
36
    or die "usage: $0 [-delay ...ms]";
 
37
 
33
38
######################################################################
34
39
# open
35
40
eval {
137
142
 
138
143
######################################################################
139
144
# getOpenFile etc.
140
 
SKIP: {
141
 
    skip("getOpenFile etc. only on X11", 3)
142
 
        if $Tk::platform ne 'unix';
 
145
TODO: {
 
146
## XXX works everywhere?
 
147
#     skip("getOpenFile etc. only on X11", 3)
 
148
#       if $Tk::platform ne 'unix';
 
149
    todo_skip("known coredumps with multiple MainWindows on some systems", 5)
 
150
        if 1;
143
151
 
144
 
    {
 
152
    catch_grabs {
145
153
        my $mw = MainWindow->new;
 
154
        $mw->geometry('+0+0');
146
155
        $mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
147
156
        my $result = $mw->getOpenFile;
148
157
        if (!$ENV{BATCH}) {
149
158
            diag "Result is <$result>";
150
159
        }
151
160
        pass("called getOpenFile");
152
 
    }
 
161
    };
153
162
 
154
 
    {
 
163
    catch_grabs {
155
164
        my $mw = MainWindow->new;
 
165
        $mw->geometry('+0+0');
156
166
        $mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
157
167
        my $result = $mw->getSaveFile;
158
168
        if (!$ENV{BATCH}) {
159
169
            diag "Result is <$result>";
160
170
        }
161
171
        pass("called getSaveFile");
162
 
    }
 
172
    };
163
173
 
164
 
    {
 
174
    catch_grabs {
165
175
        my $mw = MainWindow->new;
 
176
        $mw->geometry('+0+0');
166
177
        $mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
167
178
        my $result = $mw->chooseDirectory;
168
179
        if (!$ENV{BATCH}) {
169
180
            diag "Result is <$result>";
170
181
        }
171
182
        pass("called chooseDirectory");
172
 
    }
 
183
    };
 
184
 
 
185
    catch_grabs {
 
186
        my $mw = MainWindow->new;
 
187
        $mw->geometry('+0+0');
 
188
        $mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
 
189
        my $result = $mw->getOpenFile(-multiple => 1, -title => "getOpenFile with -multiple");
 
190
        ok(!defined $result || ref($result) eq "ARRAY", "Result of -multiple is an array reference or undef");
 
191
        if (!$ENV{BATCH}) {
 
192
            diag "Result is <@$result>" if $result;
 
193
        }
 
194
        pass("called getOpenFile with -multiple");
 
195
    };
173
196
}
174
197
 
175
198
1;