t/op/qq.t

   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);
  63 is ("\x{10FFFD}", chr 1114109);