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 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
|
use Test2::V0;
no warnings 'void';
use Scalar::Type qw(is_* type);
use B;
use Capture::Tiny qw(capture_stderr);
use Devel::Peek;
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
subtest "is_integer" => sub {
ok(is_integer(0), '0 is an integer');
ok(is_integer(-0), '-0 is an integer');
ok(is_integer(1), '1 is an integer');
ok(is_integer(-1), '-1 is an integer');
ok(!is_integer("1"), '"1" is not an integer');
ok(!is_integer(1.0), '1.0 is not an integer');
ok(!is_integer(1.1), '1.1 is not an integer');
ok(!is_integer(0.0), '0.0 is not an integer');
ok(is_integer(0x12), '0x12 is an integer');
ok(!is_integer("0x12"), '"0x12" is not an integer');
# the IV slot in the SV got filled
my $foo = "1"; $foo += 0;
ok(is_integer($foo), '"1" + 0 gets its IV slot filled, is an integer');
undef $foo;
ok(!is_integer($foo), "after undef-ing, it's no longer an integer");
};
subtest "is_number" => sub {
ok(is_number(1), '1 is a number');
ok(is_number(1.0), '1.0 is a number');
ok(is_number(1.1), '1.1 is a number');
ok(is_number(0.0), '0.0 is a number');
ok(!is_number("1"), '"1" is not a number');
ok(!is_number("1.0"), '"1.0" is not a number');
ok(!is_number("0x12"), '"0x12" is not a number');
my $foo = 0x12;
ok(is_number($foo), '0x12 is a number');
my $bar = "12.10";
ok(!is_number($bar), '"12.10" is not a number');
$bar + 0;
ok(!is_number($bar), '"12.10" is still not a number after being used in a numeric context');
note(capture_stderr { Dump($bar) });
};
subtest "integers written as exponents are weird" => sub {
# toke.c just assumes that if there's an e it must be a float. At some point it
# would be nice to correct that, but not at the cost of "correcting" 1.0 into an int.
# these tests are mostly just placeholders for when we do that.
subtest "32 bit-friendly exp ints" => sub {
ok(!is_integer(1e2), '1e2 is not an integer (but it oughta be!)');
ok(is_number(1e2), '... but it is a number');
ok(!is_integer(-1e2), '-1e2 is not an integer (but it oughta be!)');
ok(is_number(-1e2), '... but it is a number');
my $foo = 1e2; $foo += 0;
ok(is_integer($foo), '1e2 + 0 is an integer');
$foo = 0; $foo += 1e2;
ok(is_integer($foo), '0 + 1e2 is an integer');
$foo = -1e2; $foo += 0;
ok(is_integer($foo), '-1e2 + 0 is an integer');
};
subtest "32 bit-unfriendly, 64 bit-friendly exp ints" => sub {
ok(!is_integer(1e10), '1e10 is not an integer (but it oughta be on 64 bit machines!)');
ok(is_number(1e10), '... but it is a number');
ok(!is_integer(-1e10), '-1e10 is not an integer (but it oughta be on 64 bit machines!)');
ok(is_number(-1e10), '... but it is a number');
my $foo = 1e10; $foo += 0;
if(~0 < $foo) { # 32 bit system
ok(!is_integer($foo), '1e10 + 0 is not an integer because your computer is pathetic');
$foo = 0; $foo += 1e10;
ok(!is_integer($foo), '0 + 1e10 is not an integer because your computer is pathetic');
$foo = -1e10; $foo += 0;
ok(!is_integer($foo), '-1e10 + 0 is not an integer because your computer is pathetic');
} else {
ok(is_integer($foo), '1e10 + 0 is an integer');
$foo = 0; $foo += 1e10;
ok(is_integer($foo), '0 + 1e10 is an integer');
$foo = -1e10; $foo += 0;
ok(is_integer($foo), '-1e10 + 0 is an integer');
}
};
subtest "64 bit-unfriendly exp ints" => sub {
ok(!is_integer(1e20), '1e20 is not an integer');
ok(is_number(1e20), '... but it is a number');
ok(!is_integer(-1e20), '-1e20 is not an integer');
ok(is_number(-1e20), '... but it is a number');
my $foo = 1e20; $foo += 0;
ok(!is_integer($foo), '1e20 + 0 is not an integer');
ok(is_number($foo), '... but it is a number');
$foo = 0; $foo += 1e20;
ok(!is_integer($foo), '0 + 1e20 is not an integer');
ok(is_number($foo), '... but it is a number');
$foo = -1e20; $foo += 0;
ok(!is_integer($foo), '-1e20 + 0 is not an integer');
ok(is_number($foo), '... but it is a number');
};
};
subtest "string subsequently used as an int or float" => sub {
subtest "'007'" => sub {
my $foo = '007';
$foo < 8;
ok($foo eq '007', "after being treated as an int it still has its original value");
is(type($foo), 'SCALAR', "and it's not become an integer as far as we're concerned");
note(capture_stderr { Dump($foo) });
};
subtest "'007.5'" => sub {
my $foo = "007.5";
$foo + 0.5;
ok($foo eq '007.5', "after being treated as a float it still has its original value");
is(type($foo), 'SCALAR', "and it's not become a float as far as we're concerned");
note(capture_stderr { Dump($foo) });
};
subtest "'7'" => sub {
my $foo = '7';
$foo < 8;
is(type($foo), 'INTEGER', "this does become an int after a numeric operation");
note(capture_stderr { Dump($foo) });
};
subtest "'7.5'" => sub {
my $foo = '7.5';
$foo < 8;
is(type($foo), 'NUMBER', "this does become a float after a numeric operation");
note(capture_stderr { Dump($foo) });
};
subtest "'[MAXINT]'" => sub {
my $foo = ''.~0;
$foo + 0;
is(type($foo), 'INTEGER', "this becomes an integer after a numeric operation, even though the value is a UV (unsigned int), not an IV");
note(capture_stderr { Dump($foo) });
};
};
subtest "int subsequently used as a float" => sub {
my $foo = 7;
$foo + 0.5;
ok($foo == 7, "after being treated as a float the variable still has its original value 7");
ok(is_integer($foo), "7 is still an integer after being numerically compared to a float");
};
subtest "are we checking the flags, not just the contents of the IV/NV slots?" => sub {
my $foo = 42;
ok(is_integer($foo), 'variable containing 42 is an integer');
ok(is_number($foo), "... and so of course it's also a number");
$foo = 'forty two';
ok(!is_integer($foo), 'variable is no longer an int after a string was assigned to it');
ok(!is_number($foo), '... no longer a number either');
note("still says 42 in the IV slot, but IOK isn't set");
note(capture_stderr { Dump($foo) });
$foo = 3.14;
ok(!is_integer($foo), 'variable containing 3.14 is not an integer');
ok(is_number($foo), '... but it is a number');
$foo = 'delicious pie';
ok(!is_integer($foo), 'still not an integer after value changed to "delicious pie"');
ok(!is_number($foo), '... no longer a number either');
};
subtest "references" => sub {
ok(!is_integer(\1), '\\1 is not an integer');
is(type(\1), 'REF_TO_SCALAR', '\\1 is of type REF_TO_SCALAR');
is(type(\"1"), 'REF_TO_SCALAR', '\\"1" is of type REF_TO_SCALAR');
is(type({}), 'REF_TO_HASH', '{} is of type REF_TO_HASH');
is(type(B::svref_2object(\1)), 'B::IV', 'blessed scalars return their class');
};
subtest "type returns the documented values for non-reference types" => sub {
is(type(1), 'INTEGER', '1 is of type INTEGER');
is(type(1.0), 'NUMBER', '1.0 is of type NUMBER');
is(type(1.1), 'NUMBER', '1.1 is of type NUMBER');
is(type("1"), 'SCALAR', '"1" is of type SCALAR');
is(type("1.0"), 'SCALAR', '"1.0" is of type SCALAR');
is(type("1.1"), 'SCALAR', '"1.1" is of type SCALAR');
is(type(undef), 'UNDEF', 'undef is of type UNDEF');
};
like
dies { type() },
qr{::type requires an argument at t/types.t line},
"type() requires an argument";
like
dies { is_number() },
qr{::is_number requires an argument at t/types.t line},
"is_number() requires an argument";
like
dies { is_integer() },
qr{::is_integer requires an argument at t/types.t line},
"is_integer() requires an argument";
done_testing;
|