blob: 7c4cf6977393782d7eeab2d83e063e82df3d6153 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
#!perl
use Test::More;
eval "use Tk; 1" or
plan skip_all => "Tk is not installed.";
# seeing as the entire point of this test is to test the event handler,
# we need to mock as little as possible. To keep things tightly controlled,
# we'll use the Stub directly.
BEGIN {
$ENV{PERL_RL} = 'Stub o=0';
}
my $mw;
eval {
use File::Spec;
$mw = MainWindow->new(); $mw->withdraw();
1;
} or plan skip_all => "Tk can't start. DISPLAY not set?";
# need to delay this so that Tk is loaded first.
require Term::ReadLine;
plan tests => 3;
my $t = Term::ReadLine->new('Tk');
ok($t, "Created object");
is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
# This test will dispatch Tk events externally.
$t->tkRunning(0);
my $text = 'some text';
my $T = $text . "\n";
my $w = Tk::after($mw,0,
sub {
pass("Event loop called");
exit 0;
});
my $result = tk_readline($t, 'Do not press enter>');
fail("Should not get here.");
# A Tk-dispatching readline that doesn't require Tk (or any other
# event loop) support to be hard-coded into Term::ReadLine.
sub tk_readline {
my ($term, $prompt) = @_;
$term->print_prompt($prompt);
my $got_input;
Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
Tk::DoOneEvent(0) until $got_input;
return $term->get_line();
}
|
