xref: /openbsd/gnu/usr.bin/perl/t/op/oct.t (revision 91f110e0) 
1#!./perl
2
3# tests 51 onwards aren't all warnings clean. (intentionally)
4
5require './test.pl';
6use strict;
7
8plan(tests => 77);
9
10foreach(['0b1_0101', 0b101_01],
11	['0b10_101', 0_2_5],
12	['0b101_01', 2_1],
13	['0b1010_1', 0x1_5],
14	['b1_0101', 0b10101],
15	['b10_101', 025],
16	['b101_01', 21],
17	['b1010_1', 0x15],
18	['01_234', 0b10_1001_1100],
19	['012_34', 01234],
20	['0123_4', 668],
21	['01234', 0x29c],
22	['0x1_234', 0b10010_00110100],
23	['0x12_34', 01_1064],
24	['0x123_4', 4660],
25	['0x1234', 0x12_34],
26	['x1_234', 0b100100011010_0],
27	['x12_34', 0_11064],
28	['x123_4', 4660],
29	['x1234', 0x_1234],
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)
37	["b00b0101", 0],
38	["bb0101", 0],
39	["0bb0101", 0],
40	["0x0x3A", 0],
41	["0xx3A", 0],
42	["x0x3A", 0],
43	["xx3A", 0],
44	["0x3A", 0x3A],
45	["x3A", 0x3A],
46	["0x0x4", 0],
47	["0xx4", 0],
48	["x0x4", 0],
49	["xx4", 0],
50	["0x4", 4],
51	["x4", 4],
52	# Allow uppercase base markers (#76296)
53	["0XCAFE", 0xCAFE],
54	["XCAFE", 0xCAFE],
55	["0B101001", 0b101001],
56	["B101001", 0b101001],
57       ) {
58    my ($string, $value) = @$_;
59    my $result = oct $string;
60
61    my $desc = ($^O ne 'VMS' || length $string <= 256) && "oct \"$string\"";
62
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);
67    }
68}
69
70foreach(['01_234', 0b_1001000110100],
71	['012_34', 011064],
72	['0123_4', 4660],
73	['01234_', 0x1234],
74	['0x_1234', 0b1001000110100],
75	['0x1_234', 011064],
76	['0x12_34', 4660],
77	['0x1234_', 0x1234],
78	['x_1234', 0b1001000110100],
79	['x12_34', 011064],
80	['x123_4', 4660],
81	['x1234_', 0x1234],
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)
87	["0x3A", 0x3A],
88	["x3A", 0x3A],
89	["0x4",4],
90	["x4", 4],
91	# Allow uppercase base markers (#76296)
92	["0XCAFE",   0xCAFE],
93	["XCAFE",    0xCAFE],
94       ) {
95    my ($string, $value) = @$_;
96    my $result = hex $string;
97
98    my $desc = ($^O ne 'VMS' || length $string <= 256) && "hex \"$string\"";
99
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);
103    }
104}
105
106
107$_ = "\0_7_7";
108is(length, 5);
109is($_, "\0"."_"."7"."_"."7");
110chop, chop, chop, chop;
111is($_, "\0");
112if (ord("\t") != 9) {
113    # question mark is 111 in 1047, 037, && POSIX-BC
114    is("\157_", "?_");
115}
116else {
117    is("\077_", "?_");
118}
119
120$_ = "\x_7_7";
121is(length, 5);
122is($_, "\0"."_"."7"."_"."7");
123chop, chop, chop, chop;
124is($_, "\0");
125if (ord("\t") != 9) {
126    # / is 97 in 1047, 037, && POSIX-BC
127    is("\x61_", "/_");
128}
129else {
130    is("\x2F_", "/_");
131}
132
133eval '$a = oct "10\x{100}"';
134like($@, qr/Wide character/);
135
136eval '$a = hex "ab\x{100}"';
137like($@, qr/Wide character/);
138