1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8print q(1..21 9); 10 11# This is() function is written to avoid "" 12my $test = 1; 13sub 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 38is ("\x53", chr 83); 39is ("\x4EE", chr (78) . 'E'); 40is ("\x4i", chr (4) . 'i'); # This will warn 41is ("\xh", chr (0) . 'h'); # This will warn 42is ("\xx", chr (0) . 'x'); # This will warn 43is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too? 44is ("\x9_E", chr (9) . '_E'); # This will warn 45 46is ("\x{4E}", chr 78); 47is ("\x{6_9}", chr 105); 48is ("\x{_6_3}", chr 99); 49is ("\x{_6B}", chr 107); 50 51is ("\x{9__0}", chr 9); # multiple underscores not allowed. 52is ("\x{77_}", chr 119); # trailing underscore warns. 53is ("\x{6FQ}z", chr (111) . 'z'); 54 55is ("\x{0x4E}", chr 0); 56is ("\x{x4E}", chr 0); 57 58is ("\x{0065}", chr 101); 59is ("\x{000000000000000000000000000000000000000000000000000000000000000072}", 60 chr 114); 61is ("\x{0_06_5}", chr 101); 62is ("\x{1234}", chr 4660); 63is ("\x{10FFFD}", chr 1114109); 64