From 6f908f1bab380b2a2d78d238aad9752a9721f38a Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 23 Sep 2012 22:01:14 +0200 Subject: [PATCH] Test the resolution behaviour for file handles and package names. Historical behaviour is that file handles take priority over package names, and the use of PL_stashcache shouldn't change this. --- MANIFEST | 1 + t/lib/Count.pm | 8 ++++ t/op/method.t | 136 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 143 insertions(+), 2 deletions(-) create mode 100644 t/lib/Count.pm diff --git a/MANIFEST b/MANIFEST index 350312d..6ac316d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5065,6 +5065,7 @@ t/lib/Cname.pm Test charnames in regexes (op/pat.t) t/lib/common.pl Helper for lib/{warnings,feature}.t t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t +t/lib/Count.pm Helper for t/op/method.t t/lib/croak/mg Test croak calls from mg.c t/lib/croak/op Test croak calls from op.c t/lib/croak/pp_ctl Test croak calls from pp_ctl.c diff --git a/t/lib/Count.pm b/t/lib/Count.pm new file mode 100644 index 0000000..635b5de --- /dev/null +++ b/t/lib/Count.pm @@ -0,0 +1,8 @@ +# zero! ha ha ha +package Count; +"ha!"; +__DATA__ +one! ha ha ha +two! ha ha ha +three! ha ha ha +four! ha ha ha diff --git a/t/op/method.t b/t/op/method.t index 799eda0..5ed8f76 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -6,14 +6,14 @@ BEGIN { chdir 't' if -d 't'; - @INC = qw(. ../lib); + @INC = qw(. ../lib lib); require "test.pl"; } use strict; no warnings 'once'; -plan(tests => 116); +plan(tests => 141); @A::ISA = 'B'; @B::ISA = 'C'; @@ -489,3 +489,135 @@ like $@, is "3foo"->CORE::uc, '3FOO', '"3foo"->CORE::uc'; { no strict; @{"3foo::ISA"} = "CORE"; } is "3foo"->uc, '3FOO', '"3foo"->uc (autobox style!)'; + +# Test that PL_stashcache doesn't change the resolution behaviour for file +# handles and package names. +SKIP: { + skip_if_miniperl('file handles as methods requires loading IO::File', 25); + require Fcntl; + + foreach (qw (Count::DATA Count Colour::H1 Color::H1 C3::H1)) { + eval qq{ + package $_; + + sub getline { + return "method in $_"; + } + + 1; + } or die $@; + } + + BEGIN { + *The::Count:: = \*Count::; + } + + is(Count::DATA->getline(), 'method in Count::DATA', + 'initial resolution is a method'); + is(The::Count::DATA->getline(), 'method in Count::DATA', + 'initial resolution is a method in aliased classes'); + + require Count; + + is(Count::DATA->getline(), "one! ha ha ha\n", 'file handles take priority'); + is(The::Count::DATA->getline(), "two! ha ha ha\n", + 'file handles take priority in aliased classes'); + + eval q{close Count::DATA} or die $!; + + { + no warnings 'io'; + is(Count::DATA->getline(), undef, + "closing a file handle doesn't change object resolution"); + is(The::Count::DATA->getline(), undef, + "closing a file handle doesn't change object resolution in aliased classes"); +} + + undef *Count::DATA; + is(Count::DATA->getline(), 'method in Count::DATA', + 'undefining the typeglob does change object resolution'); + is(The::Count::DATA->getline(), 'method in Count::DATA', + 'undefining the typeglob does change object resolution in aliased classes'); + + is(Count->getline(), 'method in Count', + 'initial resolution is a method'); + is(The::Count->getline(), 'method in Count', + 'initial resolution is a method in aliased classes'); + + eval q{ + open Count, '<', $INC{'Count.pm'} + or die "Can't open $INC{'Count.pm'}: $!"; +1; + } or die $@; + + is(Count->getline(), "# zero! ha ha ha\n", 'file handles take priority'); + is(The::Count->getline(), 'method in Count', 'but not in an aliased class'); + + eval q{close Count} or die $!; + + { + no warnings 'io'; + is(Count->getline(), undef, + "closing a file handle doesn't change object resolution"); + } + + undef *Count; + is(Count->getline(), 'method in Count', + 'undefining the typeglob does change object resolution'); + + open Colour::H1, 'op/method.t' or die $!; + while () { + last if /^__END__/; + } + open CLOSED, 'TEST' or die $!; + close CLOSED or die $!; + + my $fh_start = tell Colour::H1; + my $data_start = tell DATA; + is(Colour::H1->getline(), , 'read from a file'); + is(Color::H1->getline(), 'method in Color::H1', + 'initial resolution is a method'); + + *Color::H1 = *Colour::H1{IO}; + + is(Colour::H1->getline(), , 'read from a file'); + is(Color::H1->getline(), , + 'file handles take priority after typeglob assignment'); + + *Color::H1 = *CLOSED{IO}; + { + no warnings 'io'; + is(Color::H1->getline(), undef, + "assigning a closed a file handle doesn't change object resolution"); + } + + undef *Color::H1; + is(Color::H1->getline(), 'method in Color::H1', + 'undefining the typeglob does change object resolution'); + + seek Colour::H1, $fh_start, Fcntl::SEEK_SET() or die $!; + seek DATA, $data_start, Fcntl::SEEK_SET() or die $!; + + is(Colour::H1->getline(), , 'read from a file'); + is(C3::H1->getline(), 'method in C3::H1', 'intial resolution is a method'); + + *Copy:: = \*C3::; + *C3:: = \*Colour::; + + is(Colour::H1->getline(), , 'read from a file'); + is(C3::H1->getline(), , + 'file handles take priority after stash aliasing'); + + *C3:: = \*Copy::; + + is(C3::H1->getline(), 'method in C3::H1', + 'restoring the stash returns to a method'); +} + +__END__ +#FF9900 +#F78C08 +#FFA500 +#FF4D00 +#FC5100 +#FF5D00 -- 1.8.3.1