Commit | Line | Data |
---|---|---|
a4c04bdc NC |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
17a3df4c | 8 | print q(1..28 |
a4c04bdc NC |
9 | ); |
10 | ||
11 | # This is() function is written to avoid "" | |
12 | my $test = 1; | |
13 | sub is { | |
14 | my($left, $right) = @_; | |
15 | ||
16 | if ($left eq $right) { | |
17 | printf 'ok %d | |
18 | ', $test++; | |
19 | return 1; | |
20 | } | |
21 | foreach ($left, $right) { | |
22 | # Comment out these regexps to map non-printables to ord if the perl under | |
23 | # test is so broken that it's not helping | |
24 | s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge; | |
25 | $_ = sprintf q('%s'), $_; | |
26 | s/^''\.//; | |
27 | s/\.''$//; | |
28 | } | |
29 | printf q(not ok %d - got %s expected %s | |
30 | ), $test++, $left, $right; | |
31 | ||
32 | printf q(# Failed test at line %d | |
33 | ), (caller)[2]; | |
34 | ||
35 | return 0; | |
36 | } | |
37 | ||
38 | is ("\x53", chr 83); | |
39 | is ("\x4EE", chr (78) . 'E'); | |
40 | is ("\x4i", chr (4) . 'i'); # This will warn | |
41 | is ("\xh", chr (0) . 'h'); # This will warn | |
42 | is ("\xx", chr (0) . 'x'); # This will warn | |
43 | is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too? | |
44 | is ("\x9_E", chr (9) . '_E'); # This will warn | |
45 | ||
46 | is ("\x{4E}", chr 78); | |
47 | is ("\x{6_9}", chr 105); | |
48 | is ("\x{_6_3}", chr 99); | |
49 | is ("\x{_6B}", chr 107); | |
50 | ||
51 | is ("\x{9__0}", chr 9); # multiple underscores not allowed. | |
52 | is ("\x{77_}", chr 119); # trailing underscore warns. | |
53 | is ("\x{6FQ}z", chr (111) . 'z'); | |
54 | ||
55 | is ("\x{0x4E}", chr 0); | |
56 | is ("\x{x4E}", chr 0); | |
57 | ||
58 | is ("\x{0065}", chr 101); | |
59 | is ("\x{000000000000000000000000000000000000000000000000000000000000000072}", | |
60 | chr 114); | |
61 | is ("\x{0_06_5}", chr 101); | |
62 | is ("\x{1234}", chr 4660); | |
b851fbc1 | 63 | is ("\x{10FFFD}", chr 1114109); |
84bb2957 KW |
64 | is ("\400", chr 0x100); |
65 | is ("\600", chr 0x180); | |
66 | is ("\777", chr 0x1FF); | |
f0a2b745 KW |
67 | is ("a\o{120}b", "a" . chr(0x50) . "b"); |
68 | is ("a\o{400}b", "a" . chr(0x100) . "b"); | |
69 | is ("a\o{1000}b", "a" . chr(0x200) . "b"); | |
f9d13529 | 70 | |
33d9abfb KW |
71 | # This caused a memory fault |
72 | no warnings "utf8"; | |
73 | is ("abc", eval qq[qq\x{8000_0000}abc\x{8000_0000}]) |