diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rwxr-xr-x | t/op/override.t | 63 |
2 files changed, 64 insertions, 0 deletions
@@ -1765,6 +1765,7 @@ t/op/nothr5005.t local @_ test which does not work under use5005threads t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work t/op/ord.t See if ord works +t/op/override.t See if operator overriding works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work t/op/pos.t See if pos works diff --git a/t/op/override.t b/t/op/override.t new file mode 100755 index 0000000000..d24bdee31a --- /dev/null +++ b/t/op/override.t @@ -0,0 +1,63 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '.'; + push @INC, '../lib'; +} + +print "1..10\n"; + +# +# This file tries to test builtin override using CORE::GLOBAL +# +my $dirsep = "/"; + +BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } } + +print "not " unless getlogin eq "kilroy"; +print "ok 1\n"; + +my $t = 42; +BEGIN { *CORE::GLOBAL::time = sub () { $t; } } + +print "not " unless 45 == time + 3; +print "ok 2\n"; + +# +# require has special behaviour +# +my $r; +BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } } + +require Foo; +print "not " unless $r eq "Foo.pm"; +print "ok 3\n"; + +require Foo::Bar; +print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); +print "ok 4\n"; + +require 'Foo'; +print "not " unless $r eq "Foo"; +print "ok 5\n"; + +require 5.6; +print "not " unless $r eq "5.6"; +print "ok 6\n"; + +require v5.6; +print "not " unless $r == 5.006 && $r eq "\x05\x06"; +print "ok 7\n"; + +eval "use Foo"; +print "not " unless $r eq "Foo.pm"; +print "ok 8\n"; + +eval "use Foo::Bar"; +print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); +print "ok 9\n"; + +eval "use 5.6"; +print "not " unless $r eq "5.6"; +print "ok 10\n"; |