1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#!perl -w
# Test behaviour of hex and oct overrides in detail, and also how the three
# modules interact.
use Test::More tests => 35;
# For testing that existing CORE::GLOBAL overrides are not clobbered
BEGIN
{
if ($] > 5.009004)
{
no warnings 'syntax';
*CORE::GLOBAL::hex = sub(_) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
*CORE::GLOBAL::oct = sub(_) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
}
else
{
*CORE::GLOBAL::hex = sub(;$) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
*CORE::GLOBAL::oct = sub(;$) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
}
}
{
use bigint;
$_ = "20";
is hex, "32", 'bigint hex override without arguments infers $_';
is oct, "16", 'bigint oct override without arguments infers $_';
@_ = 1..20;
is hex(@_), "32", 'bigint hex override provides scalar context';
is oct(@_), "16", 'bigint oct override provides scalar context';
SKIP:
{
skip "no lexical hex/oct", 2 unless $] > do { no bigint; 5.009004};
is ref hex(1), 'Math::BigInt',
'bigint hex() works when bignum and bigrat are loaded';
is ref oct(1), 'Math::BigInt',
'bigint oct() works when bignum and bigrat are loaded';
}
}
{
use bignum;
$_ = "20";
is hex, "32", 'bignum hex override without arguments infers $_';
is oct, "16", 'bignum oct override without arguments infers $_';
@_ = 1..20;
is hex(@_), "32", 'bignum hex override provides scalar context';
is oct(@_), "16", 'bignum oct override provides scalar context';
SKIP:
{
skip "no lexical hex/oct", 2 unless $] > 5.009004;
is ref hex(1), 'Math::BigInt',
'bignum hex() works when bigint and bigrat are loaded';
is ref oct(1), 'Math::BigInt',
'bignum oct() works when bigint and bigrat are loaded';
}
}
{
use bigrat;
$_ = "20";
is hex, "32", 'bigrat hex override without arguments infers $_';
is oct, "16", 'bigrat oct override without arguments infers $_';
@_ = 1..20;
is hex(@_), "32", 'bigrat hex override provides scalar context';
is oct(@_), "16", 'bigrat oct override provides scalar context';
SKIP:
{
skip "no lexical hex/oct", 2 unless $] > 5.009004;
is ref hex(1), 'Math::BigInt',
'bigrat hex() works when bignum and bigint are loaded';
is ref oct(1), 'Math::BigInt',
'bigrat oct() works when bignum and bigint are loaded';
}
}
$hex_called = 0;
() = hex 0;
is $hex_called, 1, 'existing hex overrides are called';
$oct_called = 0;
() = oct 0;
is $oct_called, 1, 'existing oct overrides are called';
{
package _importer;
{
use bigint 'hex', 'oct';
::is \&hex, \&bigint::hex, 'exported hex function';
::is \&oct, \&bigint::oct, 'exported oct function';
}
::ok ref hex(), 'exported hex function returns ref outside pragma scope';
::ok ref oct(), 'exported oct function returns ref outside pragma scope';
::is oct("20"), "16", 'exported oct function works with "decimal"';
# (used to return 20 because it thought it was decimal)
}
{
package _importer2;
use bignum 'hex', 'oct';
::is \&hex, \&bignum::hex, 'bignum exports hex';
::is \&oct, \&bignum::oct, 'bignum exports oct';
::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint';
::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint';
}
{
package _importer3;
use bigrat 'hex', 'oct';
::is \&hex, \&bigrat::hex, 'bigrat exports hex';
::is \&oct, \&bigrat::oct, 'bigrat exports oct';
::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint';
::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint';
}
is ref(hex 0), "", 'hex export is not global';
is ref(oct 0), "", 'oct export is not global';
|
