Commit | Line | Data |
2adfde11 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '.'; |
6 | push @INC, '../lib'; |
7 | } |
8 | |
9b3023bc |
9 | print "1..17\n"; |
2adfde11 |
10 | |
11 | # |
12 | # This file tries to test builtin override using CORE::GLOBAL |
13 | # |
14 | my $dirsep = "/"; |
15 | |
16 | BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } } |
17 | |
18 | print "not " unless getlogin eq "kilroy"; |
19 | print "ok 1\n"; |
20 | |
21 | my $t = 42; |
22 | BEGIN { *CORE::GLOBAL::time = sub () { $t; } } |
23 | |
24 | print "not " unless 45 == time + 3; |
25 | print "ok 2\n"; |
26 | |
27 | # |
28 | # require has special behaviour |
29 | # |
30 | my $r; |
31 | BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } } |
32 | |
33 | require Foo; |
34 | print "not " unless $r eq "Foo.pm"; |
35 | print "ok 3\n"; |
36 | |
37 | require Foo::Bar; |
38 | print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); |
39 | print "ok 4\n"; |
40 | |
41 | require 'Foo'; |
42 | print "not " unless $r eq "Foo"; |
43 | print "ok 5\n"; |
44 | |
45 | require 5.6; |
46 | print "not " unless $r eq "5.6"; |
47 | print "ok 6\n"; |
48 | |
49 | require v5.6; |
5c7bc39a |
50 | print "not " unless abs($r - 5.006) < 0.001 && $r eq "\x05\x06"; |
2adfde11 |
51 | print "ok 7\n"; |
52 | |
53 | eval "use Foo"; |
54 | print "not " unless $r eq "Foo.pm"; |
55 | print "ok 8\n"; |
56 | |
57 | eval "use Foo::Bar"; |
58 | print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); |
59 | print "ok 9\n"; |
60 | |
61 | eval "use 5.6"; |
62 | print "not " unless $r eq "5.6"; |
63 | print "ok 10\n"; |
b9f751c0 |
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 |
71 | print "ok 11\n"; |
72 | } |
9b3023bc |
73 | |
74 | # |
75 | # readline() has special behaviour too |
76 | # |
77 | |
78 | $r = 11; |
79 | BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; } |
80 | print <FH> == 12 ? "ok 12\n" : "not ok 12\n"; |
81 | print <$fh> == 13 ? "ok 13\n" : "not ok 13\n"; |
82 | my $pad_fh; |
83 | print <$pad_fh> == 14 ? "ok 14\n" : "not ok 14\n"; |
84 | |
85 | # Non-global readline() override |
86 | BEGIN { *Rgs::readline = sub (;*) { --$r }; } |
87 | package Rgs; |
88 | print <FH> == 13 ? "ok 15\n" : "not ok 15\n"; |
89 | print <$fh> == 12 ? "ok 16\n" : "not ok 16\n"; |
90 | print <$pad_fh> == 11 ? "ok 17\n" : "not ok 17\n"; |