This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get override.t working under minitest
[perl5.git] / t / op / override.t
CommitLineData
2adfde11
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
30fe34ed 5 require './test.pl';
636f9bcf
FC
6 @INC = () unless is_miniperl();
7 unshift @INC, qw '../lib ../cpan/Text-ParseWords/lib';
069abe75
FC
8 require Config; # load these before we mess with *CORE::GLOBAL::require
9 require 'Config_heavy.pl'; # since runperl will need them
2adfde11
GS
10}
11
a93a1bfd 12plan tests => 35;
2adfde11
GS
13
14#
15# This file tries to test builtin override using CORE::GLOBAL
16#
17my $dirsep = "/";
18
19BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } }
20
30fe34ed 21is( getlogin, "kilroy" );
2adfde11
GS
22
23my $t = 42;
24BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
25
30fe34ed 26is( 45, time + 3 );
2adfde11
GS
27
28#
29# require has special behaviour
30#
31my $r;
32BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
33
34require Foo;
30fe34ed 35is( $r, "Foo.pm" );
2adfde11
GS
36
37require Foo::Bar;
30fe34ed 38is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11
GS
39
40require 'Foo';
30fe34ed 41is( $r, "Foo" );
2adfde11 42
88e9444c
NC
43require 5.006;
44is( $r, "5.006" );
2adfde11
GS
45
46require v5.6;
30fe34ed 47ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" );
2adfde11
GS
48
49eval "use Foo";
30fe34ed 50is( $r, "Foo.pm" );
2adfde11
GS
51
52eval "use Foo::Bar";
30fe34ed 53is( $r, join($dirsep, "Foo", "Bar.pm") );
2adfde11 54
81bccfe4 55{
7d69d4a6
FC
56 my @r;
57 local *CORE::GLOBAL::require = sub { push @r, shift; 1; };
81bccfe4 58 eval "use 5.006";
7d69d4a6 59 like( " @r ", qr " 5\.006 " );
81bccfe4 60}
b9f751c0 61
7c864bb3
VP
62{
63 local $_ = 'foo.pm';
64 require;
65 is( $r, 'foo.pm' );
66}
67
68{
703227f1
FC
69 BEGIN {
70 # Can’t do ‘no warnings’ with CORE::GLOBAL::require overridden. :-)
71 CORE::require warnings;
dcd695b6 72 unimport warnings 'experimental::lexical_topic';
703227f1 73 }
7c864bb3
VP
74 my $_ = 'bar.pm';
75 require;
76 is( $r, 'bar.pm' );
77}
78
b9f751c0
GS
79# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
80{
81 local(*CORE::GLOBAL::require);
82 $r = '';
83 eval "require NoNeXiSt;";
30fe34ed 84 ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) );
b9f751c0 85}
9b3023bc
RGS
86
87#
88# readline() has special behaviour too
89#
90
91$r = 11;
92BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
30fe34ed
RGS
93is( <FH> , 12 );
94is( <$fh> , 13 );
9b3023bc 95my $pad_fh;
30fe34ed 96is( <$pad_fh> , 14 );
9b3023bc
RGS
97
98# Non-global readline() override
99BEGIN { *Rgs::readline = sub (;*) { --$r }; }
149c1637
RGS
100{
101 package Rgs;
102 ::is( <FH> , 13 );
103 ::is( <$fh> , 12 );
104 ::is( <$pad_fh> , 11 );
105}
30fe34ed 106
e3f73d4e
RGS
107# Global readpipe() override
108BEGIN { *CORE::GLOBAL::readpipe = sub ($) { "$_[0] " . --$r }; }
109is( `rm`, "rm 10", '``' );
110is( qx/cp/, "cp 9", 'qx' );
111
112# Non-global readpipe() override
113BEGIN { *Rgs::readpipe = sub ($) { ++$r . " $_[0]" }; }
114{
115 package Rgs;
116 ::is( `rm`, "10 rm", '``' );
117 ::is( qx/cp/, "11 cp", 'qx' );
118}
119
93f09d7b 120# Verify that the parsing of overridden keywords isn't messed up
30fe34ed
RGS
121# by the indirect object notation
122{
123 local $SIG{__WARN__} = sub {
124 ::like( $_[0], qr/^ok overriden at/ );
125 };
126 BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; }
127 package OverridenWarn;
128 sub foo { "ok" }
129 warn( OverridenWarn->foo() );
130 warn OverridenWarn->foo();
131}
132BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
149c1637
RGS
133{
134 package OverridenPop;
135 sub foo { [ "ok" ] }
136 pop( OverridenPop->foo() );
137 pop OverridenPop->foo();
138}
139
140{
141 eval {
142 local *CORE::GLOBAL::require = sub {
143 CORE::require($_[0]);
144 };
145 require 5;
146 require Text::ParseWords;
147 };
148 is $@, '';
149}
70e5f2b5
FC
150
151# Constant inlining should not countermand "use subs" overrides
152BEGIN { package other; *::caller = \&::caller }
153sub caller() { 42 }
154caller; # inline the constant
155is caller, 42, 'constant inlining does not undo "use subs" on keywords';
069abe75
FC
156
157is runperl(prog => 'sub CORE::GLOBAL::do; do file; print qq-ok\n-'),
158 "ok\n",
159 'no crash with CORE::GLOBAL::do stub';
ae2c6838
FC
160is runperl(prog => 'sub CORE::GLOBAL::glob; glob; print qq-ok\n-'),
161 "ok\n",
162 'no crash with CORE::GLOBAL::glob stub';
fcea1f7a
FC
163is runperl(prog => 'sub CORE::GLOBAL::require; require re; print qq-o\n-'),
164 "o\n",
165 'no crash with CORE::GLOBAL::require stub';
952ad5fe
FC
166
167like runperl(prog => 'use constant foo=>1; '
168 .'BEGIN { *{q|CORE::GLOBAL::readpipe|} = \&{q|foo|};1}'
169 .'warn ``',
170 stderr => 1),
171 qr/Too many arguments/,
172 '`` does not ignore &CORE::GLOBAL::readpipe aliased to a constant';
a93a1bfd
FC
173like runperl(prog => 'use constant foo=>1; '
174 .'BEGIN { *{q|CORE::GLOBAL::readline|} = \&{q|foo|};1}'
175 .'warn <a>',
176 stderr => 1),
177 qr/Too many arguments/,
178 '<> does not ignore &CORE::GLOBAL::readline aliased to a constant';
60417971
FC
179
180is runperl(prog => 'use constant t=>42; '
181 .'BEGIN { *{q|CORE::GLOBAL::time|} = \&{q|t|};1}'
182 .'print time, chr 10',
183 stderr => 1),
184 "42\n",
185 'keywords respect global constant overrides';