This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make mro code pass precomputed hash values
[perl5.git] / t / op / override.t
CommitLineData
2adfde11
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
30fe34ed
RGS
5 @INC = '../lib';
6 require './test.pl';
2adfde11
GS
7}
8
70e5f2b5 9plan tests => 29;
2adfde11
GS
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
GS
19
20my $t = 42;
21BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
22
30fe34ed 23is( 45, time + 3 );
2adfde11
GS
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
GS
33
34require Foo::Bar;
30fe34ed 35is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11
GS
36
37require 'Foo';
30fe34ed 38is( $r, "Foo" );
2adfde11 39
88e9444c
NC
40require 5.006;
41is( $r, "5.006" );
2adfde11
GS
42
43require v5.6;
30fe34ed 44ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" );
2adfde11
GS
45
46eval "use Foo";
30fe34ed 47is( $r, "Foo.pm" );
2adfde11
GS
48
49eval "use Foo::Bar";
30fe34ed 50is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11 51
81bccfe4 52{
7d69d4a6
FC
53 my @r;
54 local *CORE::GLOBAL::require = sub { push @r, shift; 1; };
81bccfe4 55 eval "use 5.006";
7d69d4a6 56 like( " @r ", qr " 5\.006 " );
81bccfe4 57}
b9f751c0 58
7c864bb3
VP
59{
60 local $_ = 'foo.pm';
61 require;
62 is( $r, 'foo.pm' );
63}
64
65{
703227f1
FC
66 BEGIN {
67 # Can’t do ‘no warnings’ with CORE::GLOBAL::require overridden. :-)
68 CORE::require warnings;
dcd695b6 69 unimport warnings 'experimental::lexical_topic';
703227f1 70 }
7c864bb3
VP
71 my $_ = 'bar.pm';
72 require;
73 is( $r, 'bar.pm' );
74}
75
b9f751c0
GS
76# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
77{
78 local(*CORE::GLOBAL::require);
79 $r = '';
80 eval "require NoNeXiSt;";
30fe34ed 81 ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) );
b9f751c0 82}
9b3023bc
RGS
83
84#
85# readline() has special behaviour too
86#
87
88$r = 11;
89BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
30fe34ed
RGS
90is( <FH> , 12 );
91is( <$fh> , 13 );
9b3023bc 92my $pad_fh;
30fe34ed 93is( <$pad_fh> , 14 );
9b3023bc
RGS
94
95# Non-global readline() override
96BEGIN { *Rgs::readline = sub (;*) { --$r }; }
149c1637
RGS
97{
98 package Rgs;
99 ::is( <FH> , 13 );
100 ::is( <$fh> , 12 );
101 ::is( <$pad_fh> , 11 );
102}
30fe34ed 103
e3f73d4e
RGS
104# Global readpipe() override
105BEGIN { *CORE::GLOBAL::readpipe = sub ($) { "$_[0] " . --$r }; }
106is( `rm`, "rm 10", '``' );
107is( qx/cp/, "cp 9", 'qx' );
108
109# Non-global readpipe() override
110BEGIN { *Rgs::readpipe = sub ($) { ++$r . " $_[0]" }; }
111{
112 package Rgs;
113 ::is( `rm`, "10 rm", '``' );
114 ::is( qx/cp/, "11 cp", 'qx' );
115}
116
93f09d7b 117# Verify that the parsing of overridden keywords isn't messed up
30fe34ed
RGS
118# by the indirect object notation
119{
120 local $SIG{__WARN__} = sub {
121 ::like( $_[0], qr/^ok overriden at/ );
122 };
123 BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; }
124 package OverridenWarn;
125 sub foo { "ok" }
126 warn( OverridenWarn->foo() );
127 warn OverridenWarn->foo();
128}
129BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
149c1637
RGS
130{
131 package OverridenPop;
132 sub foo { [ "ok" ] }
133 pop( OverridenPop->foo() );
134 pop OverridenPop->foo();
135}
136
137{
138 eval {
139 local *CORE::GLOBAL::require = sub {
140 CORE::require($_[0]);
141 };
142 require 5;
143 require Text::ParseWords;
144 };
145 is $@, '';
146}
70e5f2b5
FC
147
148# Constant inlining should not countermand "use subs" overrides
149BEGIN { package other; *::caller = \&::caller }
150sub caller() { 42 }
151caller; # inline the constant
152is caller, 42, 'constant inlining does not undo "use subs" on keywords';