t/opbasic/qq.t

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