Commit | Line | Data |
---|---|---|
a4c04bdc NC |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
8 | print q(1..21 | |
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); |