3 # tests 51 onwards aren't all warnings clean. (intentionally)
10 foreach(['0b1_0101', 0b101_01],
18 ['01_234', 0b10_1001_1100],
22 ['0x1_234', 0b10010_00110100],
26 ['x1_234', 0b100100011010_0],
30 ['0b1111_1111_1111_1111_1111_1111_1111_1111', 4294967295],
31 ['037_777_777_777', 4294967295],
32 ['0xffff_ffff', 4294967295],
33 ['0b'.( '0'x10).'1_0101', 0b101_01],
34 ['0b'.( '0'x100).'1_0101', 0b101_01],
35 ['0b'.('0'x1000).'1_0101', 0b101_01],
36 # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
52 # Allow uppercase base markers (#76296)
55 ["0B101001", 0b101001],
56 ["B101001", 0b101001],
58 my ($string, $value) = @$_;
59 my $result = oct $string;
61 my $desc = ($^O ne 'VMS' || length $string <= 256) && "oct \"$string\"";
63 unless (cmp_ok($value, '==', $result, $desc)) {
64 my $format = ($string =~ /([bx])/i) ? "0\L$1%\U$1": '0%o';
65 diag(sprintf "oct '%s' gives '%s' ($format), not %s ($format)",
66 $string, $result, $result, $value, $value);
70 foreach(['01_234', 0b_1001000110100],
74 ['0x_1234', 0b1001000110100],
78 ['x_1234', 0b1001000110100],
82 ['0xff_ff_ff_ff', 4294967295],
83 [( '0'x10).'01234', 0x1234],
84 [( '0'x100).'01234', 0x1234],
85 [('0'x1000).'01234', 0x1234],
86 # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
91 # Allow uppercase base markers (#76296)
95 my ($string, $value) = @$_;
96 my $result = hex $string;
98 my $desc = ($^O ne 'VMS' || length $string <= 256) && "hex \"$string\"";
100 unless (cmp_ok($value, '==', $result, $desc)) {
101 diag(sprintf "hex '%s' gives '%s' (0x%X), not %s (0x%X)",
102 $string, $result, $result, $value, $value);
109 is($_, "\0"."_"."7"."_"."7");
110 chop, chop, chop, chop;
112 if (ord("\t") != 9) {
113 # question mark is 111 in 1047, 037, && POSIX-BC
122 is($_, "\0"."_"."7"."_"."7");
123 chop, chop, chop, chop;
125 if (ord("\t") != 9) {
126 # / is 97 in 1047, 037, && POSIX-BC
133 eval '$a = oct "10\x{100}"';
134 like($@, qr/Wide character/);
136 eval '$a = hex "ab\x{100}"';
137 like($@, qr/Wide character/);