1 files changed, 59 insertions, 0 deletions
diff --git a/dist/Term-ReadLine/t/TkExternal.t b/dist/Term-ReadLine/t/TkExternal.t
new file mode 100644
index 0000000000..7c4cf69773
--- /dev/null
+++ b/dist/Term-ReadLine/t/TkExternal.t
@@ -0,0 +1,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();
+}