1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9plan tests => 21; 10 11# 12# This file tries to test builtin override using CORE::GLOBAL 13# 14my $dirsep = "/"; 15 16BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } } 17 18is( getlogin, "kilroy" ); 19 20my $t = 42; 21BEGIN { *CORE::GLOBAL::time = sub () { $t; } } 22 23is( 45, time + 3 ); 24 25# 26# require has special behaviour 27# 28my $r; 29BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } } 30 31require Foo; 32is( $r, "Foo.pm" ); 33 34require Foo::Bar; 35is( $r, join($dirsep, "Foo", "Bar.pm") ); 36 37require 'Foo'; 38is( $r, "Foo" ); 39 40require 5.6; 41is( $r, "5.6" ); 42 43require v5.6; 44ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" ); 45 46eval "use Foo"; 47is( $r, "Foo.pm" ); 48 49eval "use Foo::Bar"; 50is( $r, join($dirsep, "Foo", "Bar.pm") ); 51 52eval "use 5.6"; 53is( $r, "5.6" ); 54 55# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo 56{ 57 local(*CORE::GLOBAL::require); 58 $r = ''; 59 eval "require NoNeXiSt;"; 60 ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) ); 61} 62 63# 64# readline() has special behaviour too 65# 66 67$r = 11; 68BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; } 69is( <FH> , 12 ); 70is( <$fh> , 13 ); 71my $pad_fh; 72is( <$pad_fh> , 14 ); 73 74# Non-global readline() override 75BEGIN { *Rgs::readline = sub (;*) { --$r }; } 76package Rgs; 77::is( <FH> , 13 ); 78::is( <$fh> , 12 ); 79::is( <$pad_fh> , 11 ); 80 81# Verify that the parsing of overriden keywords isn't messed up 82# by the indirect object notation 83{ 84 local $SIG{__WARN__} = sub { 85 ::like( $_[0], qr/^ok overriden at/ ); 86 }; 87 BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; } 88 package OverridenWarn; 89 sub foo { "ok" } 90 warn( OverridenWarn->foo() ); 91 warn OverridenWarn->foo(); 92} 93BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; } 94package OverridenPop; 95sub foo { [ "ok" ] } 96pop( OverridenPop->foo() ); 97pop OverridenPop->foo(); 98