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