12 # This file tries to test builtin override using CORE::GLOBAL
16 BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } }
18 is( getlogin, "kilroy" );
21 BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
26 # require has special behaviour
29 BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
35 is( $r, join($dirsep, "Foo", "Bar.pm") );
44 ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" );
50 is( $r, join($dirsep, "Foo", "Bar.pm") );
55 # localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
57 local(*CORE::GLOBAL::require);
59 eval "require NoNeXiSt;";
60 ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) );
64 # readline() has special behaviour too
68 BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
74 # Non-global readline() override
75 BEGIN { *Rgs::readline = sub (;*) { --$r }; }
79 ::is( <$pad_fh> , 11 );
81 # Verify that the parsing of overriden keywords isn't messed up
82 # by the indirect object notation
84 local $SIG{__WARN__} = sub {
85 ::like( $_[0], qr/^ok overriden at/ );
87 BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; }
88 package OverridenWarn;
90 warn( OverridenWarn->foo() );
91 warn OverridenWarn->foo();
93 BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
96 pop( OverridenPop->foo() );
97 pop OverridenPop->foo();