Term::ReadLine tweaks and test

Message-ID: <20011210005147.GA1073@mirth.demon.co.uk>

p4raw-id: //depot/perl@13576

diff --git a/MANIFEST b/MANIFEST
index a2cb674..b8ccc88 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1209,6 +1209,7 @@ lib/Term/Cap.t                    See if Term::Cap works
 lib/Term/Complete.pm           A command completion subroutine
 lib/Term/Complete.t            See if Term::Complete works
 lib/Term/ReadLine.pm           Stub readline library
+lib/Term/ReadLine.t            See if Term::ReadLine works
 lib/termcap.pl                 Perl library supporting termcap usage
 lib/Test.pm                    A simple framework for writing test scripts
 lib/Test/Builder.pm             For writing new test libraries

diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm
index 5a8c251..a23208c 100644 (file)
--- a/lib/Term/ReadLine.pm
+++ b/lib/Term/ReadLine.pm
@@ -41,7 +41,7 @@ where $term is a return value of Term::ReadLine-E<gt>Init.
 
 returns the actual package that executes the commands. Among possible
 values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
-C<Term::ReadLine::Stub Exporter>.
+C<Term::ReadLine::Stub>.
 
 =item C<new>
 
@@ -311,6 +311,8 @@ if (defined &Term::ReadLine::Gnu::readline) {
   @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
 } elsif (defined &Term::ReadLine::Perl::readline) {
   @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
+} elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) {
+  @ISA = "Term::ReadLine::$which";
 } else {
   @ISA = qw(Term::ReadLine::Stub);
 }

diff --git a/lib/Term/ReadLine.t b/lib/Term/ReadLine.t
new file mode 100644 (file)
index 0000000..a3d5756
--- /dev/null
+++ b/lib/Term/ReadLine.t
@@ -0,0 +1,39 @@
+#!./perl -w
+use strict;
+
+BEGIN {
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+package Term::ReadLine::Mock;
+our @ISA = 'Term::ReadLine::Stub';
+sub ReadLine {'Term::ReadLine::Mock'};
+sub readline { "a line" }
+sub new      { bless {} }
+
+package main;
+
+use Test::More tests => 15;
+
+BEGIN {
+    $ENV{PERL_RL} = 'Mock'; # test against our instrumented class
+    use_ok('Term::ReadLine');
+}
+
+my $t = new Term::ReadLine 'test term::readline';
+
+ok($t, "made something");
+
+isa_ok($t,          'Term::ReadLine::Mock');
+
+for my $method (qw( ReadLine readline addhistory IN OUT MinLine
+                    findConsole Attribs Features new ) ) {
+    can_ok($t, $method);
+}
+
+is($t->ReadLine,    'Term::ReadLine::Mock', "\$object->ReadLine");
+is($t->readline,    'a line',               "\$object->readline");
+