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