Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / op / override.t
CommitLineData
2adfde11 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
30fe34ed 5 @INC = '../lib';
6 require './test.pl';
2adfde11 7}
8
e3f73d4e 9plan tests => 26;
2adfde11 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
30fe34ed 18is( getlogin, "kilroy" );
2adfde11 19
20my $t = 42;
21BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
22
30fe34ed 23is( 45, time + 3 );
2adfde11 24
25#
26# require has special behaviour
27#
28my $r;
29BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
30
31require Foo;
30fe34ed 32is( $r, "Foo.pm" );
2adfde11 33
34require Foo::Bar;
30fe34ed 35is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11 36
37require 'Foo';
30fe34ed 38is( $r, "Foo" );
2adfde11 39
40require 5.6;
30fe34ed 41is( $r, "5.6" );
2adfde11 42
43require v5.6;
30fe34ed 44ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" );
2adfde11 45
46eval "use Foo";
30fe34ed 47is( $r, "Foo.pm" );
2adfde11 48
49eval "use Foo::Bar";
30fe34ed 50is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11 51
52eval "use 5.6";
30fe34ed 53is( $r, "5.6" );
b9f751c0 54
55# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
56{
57 local(*CORE::GLOBAL::require);
58 $r = '';
59 eval "require NoNeXiSt;";
30fe34ed 60 ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) );
b9f751c0 61}
9b3023bc 62
63#
64# readline() has special behaviour too
65#
66
67$r = 11;
68BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
30fe34ed 69is( <FH> , 12 );
70is( <$fh> , 13 );
9b3023bc 71my $pad_fh;
30fe34ed 72is( <$pad_fh> , 14 );
9b3023bc 73
74# Non-global readline() override
75BEGIN { *Rgs::readline = sub (;*) { --$r }; }
149c1637 76{
77 package Rgs;
78 ::is( <FH> , 13 );
79 ::is( <$fh> , 12 );
80 ::is( <$pad_fh> , 11 );
81}
30fe34ed 82
e3f73d4e 83# Global readpipe() override
84BEGIN { *CORE::GLOBAL::readpipe = sub ($) { "$_[0] " . --$r }; }
85is( `rm`, "rm 10", '``' );
86is( qx/cp/, "cp 9", 'qx' );
87
88# Non-global readpipe() override
89BEGIN { *Rgs::readpipe = sub ($) { ++$r . " $_[0]" }; }
90{
91 package Rgs;
92 ::is( `rm`, "10 rm", '``' );
93 ::is( qx/cp/, "11 cp", 'qx' );
94}
95
30fe34ed 96# Verify that the parsing of overriden keywords isn't messed up
97# by the indirect object notation
98{
99 local $SIG{__WARN__} = sub {
100 ::like( $_[0], qr/^ok overriden at/ );
101 };
102 BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; }
103 package OverridenWarn;
104 sub foo { "ok" }
105 warn( OverridenWarn->foo() );
106 warn OverridenWarn->foo();
107}
108BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
149c1637 109{
110 package OverridenPop;
111 sub foo { [ "ok" ] }
112 pop( OverridenPop->foo() );
113 pop OverridenPop->foo();
114}
115
116{
117 eval {
118 local *CORE::GLOBAL::require = sub {
119 CORE::require($_[0]);
120 };
121 require 5;
122 require Text::ParseWords;
123 };
124 is $@, '';
125}