This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/oct.t: Add descriptions to tests lacking them.
[perl5.git] / t / op / oct.t
CommitLineData
8d063cd8
LW
1#!./perl
2
ba4de515 3# Tests 51 onwards are intentionally not all-warnings-clean
53305cf1 4
c91473c9 5require './test.pl';
0d160371 6use strict;
53305cf1 7
c91473c9 8plan(tests => 77);
53305cf1 9
0d160371
NC
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);
53305cf1 67 }
53305cf1
NC
68}
69
0d160371
NC
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}
53305cf1 105
b21ed0a9
GS
106
107$_ = "\0_7_7";
ba4de515
JK
108is(length, 5,
109 "length() correctly calculated string with nul character in octal");
110is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
b21ed0a9 111chop, chop, chop, chop;
ba4de515 112is($_, "\0", "repeated chop() eliminated all but nul character");
2f2d036a 113if (ord("\t") != 9) {
ba4de515
JK
114 is("\157_", "?_",
115 "question mark is 111 in 1047, 037, && POSIX-BC");
2f2d036a
PP
116}
117else {
ba4de515
JK
118 is("\077_", "?_",
119 "question mark is 077 in other than 1047, 037, && POSIX-BC");
2f2d036a 120}
b21ed0a9
GS
121
122$_ = "\x_7_7";
ba4de515
JK
123is(length, 5,
124 "length() correctly calculated string with nul character in hex");
125is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character");
b21ed0a9 126chop, chop, chop, chop;
ba4de515 127is($_, "\0", "repeated chop() eliminated all but nul character");
2f2d036a 128if (ord("\t") != 9) {
ba4de515
JK
129 is("\x61_", "/_",
130 "/ is 97 in 1047, 037, && POSIX-BC");
2f2d036a
PP
131}
132else {
ba4de515
JK
133 is("\x2F_", "/_",
134 "/ is 79 in other than 1047, 037, && POSIX-BC");
2f2d036a 135}
93312bbf 136
1ac95999 137eval '$a = oct "10\x{100}"';
ba4de515 138like($@, qr/Wide character/, "wide character - oct");
1ac95999
JH
139
140eval '$a = hex "ab\x{100}"';
ba4de515 141like($@, qr/Wide character/, "wide character - hex");