3 # Tests 51 onwards are intentionally not all-warnings-clean
11 foreach(['0b1_0101', 0b101_01],
19 ['01_234', 0b10_1001_1100],
23 ['0x1_234', 0b10010_00110100],
27 ['x1_234', 0b100100011010_0],
31 ['0b1111_1111_1111_1111_1111_1111_1111_1111', 4294967295],
32 ['037_777_777_777', 4294967295],
33 ['0xffff_ffff', 4294967295],
34 ['0b'.( '0'x10).'1_0101', 0b101_01],
35 ['0b'.( '0'x100).'1_0101', 0b101_01],
36 ['0b'.('0'x1000).'1_0101', 0b101_01],
37 # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
53 # Allow uppercase base markers (#76296)
56 ["0B101001", 0b101001],
57 ["B101001", 0b101001],
59 my ($string, $value) = @$_;
60 my $result = oct $string;
62 my $desc = ($^O ne 'VMS' || length $string <= 256) && "oct \"$string\"";
64 unless (cmp_ok($value, '==', $result, $desc)) {
65 my $format = ($string =~ /([bx])/i) ? "0\L$1%\U$1": '0%o';
66 diag(sprintf "oct '%s' gives '%s' ($format), not %s ($format)",
67 $string, $result, $result, $value, $value);
71 foreach(['01_234', 0b_1001000110100],
75 ['0x_1234', 0b1001000110100],
79 ['x_1234', 0b1001000110100],
83 ['0xff_ff_ff_ff', 4294967295],
84 [( '0'x10).'01234', 0x1234],
85 [( '0'x100).'01234', 0x1234],
86 [('0'x1000).'01234', 0x1234],
87 # Things that perl 5.6.1 and 5.7.2 did wrong (plus some they got right)
92 # Allow uppercase base markers (#76296)
96 my ($string, $value) = @$_;
97 my $result = hex $string;
99 my $desc = ($^O ne 'VMS' || length $string <= 256) && "hex \"$string\"";
101 unless (cmp_ok($value, '==', $result, $desc)) {
102 diag(sprintf "hex '%s' gives '%s' (0x%X), not %s (0x%X)",
103 $string, $result, $result, $value, $value);
110 "length() correctly calculated string with nul character in octal");
111 is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
112 chop, chop, chop, chop;
113 is($_, "\0", "repeated chop() eliminated all but nul character");
116 "question mark is 111 in 1047, 037, && POSIX-BC");
120 "question mark is 077 in other than 1047, 037, && POSIX-BC");
125 "length() correctly calculated string with nul character in hex");
126 is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
127 chop, chop, chop, chop;
128 is($_, "\0", "repeated chop() eliminated all but nul character");
131 "/ is 97 in 1047, 037, && POSIX-BC");
135 "/ is 79 in other than 1047, 037, && POSIX-BC");
138 eval '$a = oct "10\x{100}"';
139 like($@, qr/Wide character/, "wide character - oct");
141 eval '$a = hex "ab\x{100}"';
142 like($@, qr/Wide character/, "wide character - hex");