diff options
author | Karl Williamson <public@khwilliamson.com> | 2012-03-16 14:39:48 -0600 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2012-03-16 14:45:46 -0600 |
commit | d5792bc0dcd67005f5a14c6cf6495d69d7f67a2d (patch) | |
tree | f2891910b145d868fafd25dd8e1985e9eb017177 | |
parent | 71e58fb090de808a257082977c7879c643c2e163 (diff) | |
download | perl-smoke-me/khw-mktables.tar.gz |
to get back to bleadsmoke-me/khw-mktables
-rw-r--r-- | dist/Term-ReadLine/t/Tk.t | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/dist/Term-ReadLine/t/Tk.t b/dist/Term-ReadLine/t/Tk.t new file mode 100644 index 0000000000..e2412248f4 --- /dev/null +++ b/dist/Term-ReadLine/t/Tk.t @@ -0,0 +1,42 @@ +#!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'); +$t->tkRunning(1); + +my $text = 'some text'; +my $T = $text . "\n"; + +my $w = Tk::after($mw,0, + sub { + pass("Event loop called"); + exit 0; + }); + +my $result = $t->readline('Do not press enter>'); +fail("Should not get here."); |