From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 7 Feb 2010 01:55:32 +0000 (-0800)
Subject: Improvements to 31c9a3 - CPAN code did depend on the previous behaviour of blessing... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d963bf01c4c4db296760b1148f98bf668efcaf58;p=p5sagit%2Fp5-mst-13.2.git

Improvements to 31c9a3 - CPAN code did depend on the previous behaviour of blessing filehandles into FileHandle

It turns out that it's not quite as simple as blessing into IO::File.
If you do (just) that, then it breaks any existing code that does
C<require IO::Handle;> to allow it to call methods on file handles,
because they're blessed into IO::File, which isn't loaded. (Note this code
doesn't assume that methods in IO::Seekable are there to be called)

So, it all should work if you also set @IO::File:::ISA correctly?
That way, code that assumes that methods from IO::Handle can be called will
work. However, gv.c now starts complaining (but not failing) if IO::Handle,
IO::Seekable and Exporter aren't present, because it goes looking for
methods in them.

So the solution seems to be to set @IO::File::ISA *and* create (empty)
stashes for the other 3 packages. Patch appended, but not applied.
---

diff --git a/MANIFEST b/MANIFEST
index 7339570..b065311 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4389,6 +4389,7 @@ t/op/exec.t			See if exec, system and qx work
 t/op/exists_sub.t		See if exists(&sub) works
 t/op/exp.t			See if math functions work
 t/op/fh.t			See if filehandles work
+t/op/filehandle.t		Tests for http://rt.perl.org/rt3/Ticket/Display.html?id=72586
 t/op/filetest.t			See if file tests work
 t/op/filetest_t.t		See if -t file test works
 t/op/flip.t			See if range operator works
diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 33958b8..fc26157 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -618,7 +618,7 @@ do_test(25,
     FLAGS = \\(OBJECT\\)
     IV = 0					# $] < 5.011
     NV = 0					# $] < 5.011
-    STASH = $ADDR\s+"IO::Handle"
+    STASH = $ADDR\s+"IO::File"
     IFP = $ADDR
     OFP = $ADDR
     DIRP = 0x0
diff --git a/perl.c b/perl.c
index 9f7e831..04184be 100644
--- a/perl.c
+++ b/perl.c
@@ -3863,10 +3863,34 @@ S_init_predump_symbols(pTHX)
     dVAR;
     GV *tmpgv;
     IO *io;
+    AV *isa;
 
     sv_setpvs(get_sv("\"", GV_ADD), " ");
     PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
 
+
+    /* Historically, PVIOs were blessed into IO::Handle, unless
+       FileHandle was loaded, in which case they were blessed into
+       that. Action at a distance.
+       However, if we simply bless into IO::Handle, we break code
+       that assumes that PVIOs will have (among others) a seek
+       method. IO::File inherits from IO::Handle and IO::Seekable,
+       and provides the needed methods. But if we simply bless into
+       it, then we break code that assumed that by loading
+       IO::Handle, *it* would work.
+       So a compromise is to set up the correct @IO::File::ISA,
+       so that code that does C<use IO::Handle>; will still work.
+    */
+		   
+    isa = get_av("IO::File::ISA", GV_ADD | GV_ADDMULTI);
+    av_push(isa, newSVpvs("IO::Handle"));
+    av_push(isa, newSVpvs("IO::Seekable"));
+    av_push(isa, newSVpvs("Exporter"));
+    (void) gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVGV);
+    (void) gv_fetchpvs("IO::Seekable::", GV_ADD, SVt_PVGV);
+    (void) gv_fetchpvs("Exporter::", GV_ADD, SVt_PVGV);
+
+
     PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
     io = GvIOp(PL_stdingv);
diff --git a/sv.c b/sv.c
index a3eb187..3b16d7d 100644
--- a/sv.c
+++ b/sv.c
@@ -1431,7 +1431,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
 
 	if (new_type == SVt_PVIO) {
 	    IO * const io = MUTABLE_IO(sv);
-	    GV *iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+	    GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
 
 	    SvOBJECT_on(io);
 	    /* Clear the stashcache because a new IO could overrule a package
diff --git a/t/op/filehandle.t b/t/op/filehandle.t
new file mode 100644
index 0000000..408c670
--- /dev/null
+++ b/t/op/filehandle.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# There are few filetest operators that are portable enough to test.
+# See pod/perlport.pod for details.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan 4;
+use FileHandle;
+
+my $str = "foo";
+open my $fh, "<", \$str;
+is <$fh>, "foo";
+
+eval {
+   $fh->seek(0, 0);
+   is $fh->tell, 0;
+   is <$fh>, "foo";
+};
+
+is $@, '';
diff --git a/t/op/ref.t b/t/op/ref.t
index aca94a3..db43562 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -193,8 +193,8 @@ for (
     like ("$ref", qr/^$type\(0x[0-9a-f]+\)$/, "stringify for ref to $desc");
 }
 
-is (ref *STDOUT{IO}, 'IO::Handle', 'IO refs are blessed into IO::Handle');
-like (*STDOUT{IO}, qr/^IO::Handle=IO\(0x[0-9a-f]+\)$/,
+is (ref *STDOUT{IO}, 'IO::File', 'IO refs are blessed into IO::File');
+like (*STDOUT{IO}, qr/^IO::File=IO\(0x[0-9a-f]+\)$/,
     'stringify for IO refs');
 
 # Test anonymous hash syntax.
diff --git a/t/op/stash.t b/t/op/stash.t
index 8ea829b..1296b8b 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -10,9 +10,9 @@ BEGIN { require "./test.pl"; }
 plan( tests => 31 );
 
 # Used to segfault (bug #15479)
-fresh_perl_is(
+fresh_perl_like(
     '%:: = ""',
-    'Odd number of elements in hash assignment at - line 1.',
+    qr/Odd number of elements in hash assignment at - line 1\./,
     { switches => [ '-w' ] },
     'delete $::{STDERR} and print a warning',
 );