This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #17376] Bug Report - our(%)
[perl5.git] / t / op / override.t
CommitLineData
2adfde11
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '.';
6 push @INC, '../lib';
7}
8
9b3023bc 9print "1..17\n";
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
18print "not " unless getlogin eq "kilroy";
19print "ok 1\n";
20
21my $t = 42;
22BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
23
24print "not " unless 45 == time + 3;
25print "ok 2\n";
26
27#
28# require has special behaviour
29#
30my $r;
31BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
32
33require Foo;
34print "not " unless $r eq "Foo.pm";
35print "ok 3\n";
36
37require Foo::Bar;
38print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
39print "ok 4\n";
40
41require 'Foo';
42print "not " unless $r eq "Foo";
43print "ok 5\n";
44
45require 5.6;
46print "not " unless $r eq "5.6";
47print "ok 6\n";
48
49require v5.6;
5c7bc39a 50print "not " unless abs($r - 5.006) < 0.001 && $r eq "\x05\x06";
2adfde11
GS
51print "ok 7\n";
52
53eval "use Foo";
54print "not " unless $r eq "Foo.pm";
55print "ok 8\n";
56
57eval "use Foo::Bar";
58print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
59print "ok 9\n";
60
61eval "use 5.6";
62print "not " unless $r eq "5.6";
63print "ok 10\n";
b9f751c0
GS
64
65# localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
66{
67 local(*CORE::GLOBAL::require);
68 $r = '';
69 eval "require NoNeXiSt;";
ea071790 70 print "not " if $r or $@ !~ /^Can't locate NoNeXiSt/i;
b9f751c0
GS
71 print "ok 11\n";
72}
9b3023bc
RGS
73
74#
75# readline() has special behaviour too
76#
77
78$r = 11;
79BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
80print <FH> == 12 ? "ok 12\n" : "not ok 12\n";
81print <$fh> == 13 ? "ok 13\n" : "not ok 13\n";
82my $pad_fh;
83print <$pad_fh> == 14 ? "ok 14\n" : "not ok 14\n";
84
85# Non-global readline() override
86BEGIN { *Rgs::readline = sub (;*) { --$r }; }
87package Rgs;
88print <FH> == 13 ? "ok 15\n" : "not ok 15\n";
89print <$fh> == 12 ? "ok 16\n" : "not ok 16\n";
90print <$pad_fh> == 11 ? "ok 17\n" : "not ok 17\n";