diff options
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | ext/Devel-Peek/t/Peek.t | 2 | ||||
-rw-r--r-- | perl.c | 24 | ||||
-rw-r--r-- | sv.c | 2 | ||||
-rw-r--r-- | t/op/filehandle.t | 25 | ||||
-rw-r--r-- | t/op/ref.t | 4 | ||||
-rw-r--r-- | t/op/stash.t | 4 |
7 files changed, 56 insertions, 6 deletions
@@ -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 @@ -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); @@ -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', ); |