Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
ba4de515 | 3 | # Tests 51 onwards are intentionally not all-warnings-clean |
53305cf1 | 4 | |
c91473c9 | 5 | require './test.pl'; |
0d160371 | 6 | use strict; |
53305cf1 | 7 | |
c91473c9 | 8 | plan(tests => 77); |
53305cf1 | 9 | |
0d160371 NC |
10 | foreach(['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 |
70 | foreach(['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 |
108 | is(length, 5, |
109 | "length() correctly calculated string with nul character in octal"); | |
110 | is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character"); | |
b21ed0a9 | 111 | chop, chop, chop, chop; |
ba4de515 | 112 | is($_, "\0", "repeated chop() eliminated all but nul character"); |
2f2d036a | 113 | if (ord("\t") != 9) { |
ba4de515 JK |
114 | is("\157_", "?_", |
115 | "question mark is 111 in 1047, 037, && POSIX-BC"); | |
2f2d036a PP |
116 | } |
117 | else { | |
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 |
123 | is(length, 5, |
124 | "length() correctly calculated string with nul character in hex"); | |
125 | is($_, "\0"."_"."7"."_"."7", "string concatenation with nul character"); | |
b21ed0a9 | 126 | chop, chop, chop, chop; |
ba4de515 | 127 | is($_, "\0", "repeated chop() eliminated all but nul character"); |
2f2d036a | 128 | if (ord("\t") != 9) { |
ba4de515 JK |
129 | is("\x61_", "/_", |
130 | "/ is 97 in 1047, 037, && POSIX-BC"); | |
2f2d036a PP |
131 | } |
132 | else { | |
ba4de515 JK |
133 | is("\x2F_", "/_", |
134 | "/ is 79 in other than 1047, 037, && POSIX-BC"); | |
2f2d036a | 135 | } |
93312bbf | 136 | |
1ac95999 | 137 | eval '$a = oct "10\x{100}"'; |
ba4de515 | 138 | like($@, qr/Wide character/, "wide character - oct"); |
1ac95999 JH |
139 | |
140 | eval '$a = hex "ab\x{100}"'; | |
ba4de515 | 141 | like($@, qr/Wide character/, "wide character - hex"); |