Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
53305cf1 NC |
3 | # tests 51 onwards aren't all warnings clean. (intentionally) |
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"; | |
c91473c9 NC |
108 | is(length, 5); |
109 | is($_, "\0"."_"."7"."_"."7"); | |
b21ed0a9 | 110 | chop, chop, chop, chop; |
c91473c9 | 111 | is($_, "\0"); |
2f2d036a PP |
112 | if (ord("\t") != 9) { |
113 | # question mark is 111 in 1047, 037, && POSIX-BC | |
c91473c9 | 114 | is("\157_", "?_"); |
2f2d036a PP |
115 | } |
116 | else { | |
c91473c9 | 117 | is("\077_", "?_"); |
2f2d036a | 118 | } |
b21ed0a9 GS |
119 | |
120 | $_ = "\x_7_7"; | |
c91473c9 NC |
121 | is(length, 5); |
122 | is($_, "\0"."_"."7"."_"."7"); | |
b21ed0a9 | 123 | chop, chop, chop, chop; |
c91473c9 | 124 | is($_, "\0"); |
2f2d036a PP |
125 | if (ord("\t") != 9) { |
126 | # / is 97 in 1047, 037, && POSIX-BC | |
c91473c9 | 127 | is("\x61_", "/_"); |
2f2d036a PP |
128 | } |
129 | else { | |
c91473c9 | 130 | is("\x2F_", "/_"); |
2f2d036a | 131 | } |
93312bbf | 132 | |
1ac95999 | 133 | eval '$a = oct "10\x{100}"'; |
c91473c9 | 134 | like($@, qr/Wide character/); |
1ac95999 JH |
135 | |
136 | eval '$a = hex "ab\x{100}"'; | |
c91473c9 | 137 | like($@, qr/Wide character/); |