summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MANIFEST1
-rw-r--r--ext/Devel-Peek/t/Peek.t2
-rw-r--r--perl.c24
-rw-r--r--sv.c2
-rw-r--r--t/op/filehandle.t25
-rw-r--r--t/op/ref.t4
-rw-r--r--t/op/stash.t4
7 files changed, 56 insertions, 6 deletions
diff --git a/MANIFEST b/MANIFEST
index 73395702a3..b065311f1d 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 33958b81d8..fc26157022 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 9f7e831db5..04184be040 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 a3eb187fa5..3b16d7d706 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 0000000000..408c6701c1
--- /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 aca94a3567..db43562999 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 8ea829baa1..1296b8b363 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',
);