test suite and fix input_line_number()

	Message-ID: <19990429062814.A17906@west-tip.transeda.com>
	Subject: [PATCH] IO::Handle 1.20 (was Re: FAIL Gedcom-1.01 i86pc-solaris 2.6)

p4raw-id: //depot/perl@3365

diff --git a/MANIFEST b/MANIFEST
index 050b123..d1a0d98 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1120,6 +1120,7 @@ t/lib/hostname.t  See if Sys::Hostname works
 t/lib/io_const.t       See if constants from IO work
 t/lib/io_dir.t         See if directory-related methods from IO work
 t/lib/io_dup.t         See if dup()-related methods from IO work
+t/lib/io_linenum.t     See if I/O line numbers are tracked correctly
 t/lib/io_multihomed.t  See if INET sockets work with multi-homed hosts
 t/lib/io_pipe.t                See if pipe()-related methods from IO work
 t/lib/io_poll.t                See if poll()-related methods from IO work

diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 1063f1a..02595e5 100644 (file)
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -468,16 +468,31 @@ sub input_record_separator {
 }
 
 sub input_line_number {
+    # local $. does not work properly, so we need to do it some other
+    # way.  We use select, although this is not quite right.  What we
+    # really need to know is the file handle that was the subject of the
+    # last read, seek or tell.
     my $now  = select;
     my $keep = $.;
     my $tell = tell qualify($_[0], caller) if ref($_[0]);
     my $prev = $.;
     $. = $_[1] if @_ > 1;
+    no strict "refs";
     $tell = tell $now;
     $. = $keep;
     $prev;
 }
 
+=for when local $. works properly
+sub input_line_number {
+    local $.;
+    my $tell = tell qualify($_[0], caller) if ref($_[0]);
+    my $prev = $.;
+    $. = $_[1] if @_ > 1;
+    $prev;
+}
+=cut
+
 sub format_page_number {
     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
     my $prev = $%;

diff --git a/t/lib/io_linenum.t b/t/lib/io_linenum.t
new file mode 100755 (executable)
index 0000000..954b05f
--- /dev/null
+++ b/t/lib/io_linenum.t
@@ -0,0 +1,67 @@
+#!./perl
+
+# test added 29th April 1998 by Paul Johnson (pjcj@transeda.com)
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib' if -d '../lib';
+}
+
+use strict;
+use IO::File;
+use Test;
+
+BEGIN { plan tests => 10, todo => [10] }
+
+sub lineno
+{
+  my ($f) = @_;
+  my $l;
+  $l .= "$. ";
+  $l .= $f->input_line_number;
+  $l .= " $.";
+  $l;
+}
+
+sub OK
+{
+  my $s = select STDOUT;                     # work around a bug in Test.pm 1.04
+  &ok;
+  select $s;
+}
+
+my $t;
+
+open (Q, __FILE__) or die $!;
+my $w = IO::File->new(__FILE__) or die $!;
+
+<Q> for (1 .. 10);
+OK(lineno($w), "10 0 10");
+
+$w->getline for (1 .. 5);
+OK(lineno($w), "5 5 5");
+
+<Q>;
+OK(lineno($w), "11 5 11");
+
+$w->getline;
+OK(lineno($w), "6 6 6");
+
+$t = tell Q;         # tell Q; provokes a warning - the world is full of bugs...
+OK(lineno($w), "11 6 11");
+
+<Q>;
+OK(lineno($w), "12 6 12");
+
+select Q;
+OK(lineno($w), "12 6 12");
+
+<Q> for (1 .. 10);
+OK(lineno($w), "22 6 22");
+
+$w->getline for (1 .. 5);
+OK(lineno($w), "11 11 11");
+
+# This test doesn't work.  It probably won't until local $. does.
+$t = tell Q;
+OK(lineno($w), "22 11 22", 'waiting for local $.');