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