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.
14 # This is() function is written to avoid ""
17 my($left, $right) = @_;
19 if ($left eq $right) {
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'), $_;
32 printf q(not ok %d - got %s expected %s
33 ), $test++, $left, $right;
35 printf q(# Failed test at line %d
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
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);
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');
58 is ("\x{0x4E}", chr 0);
59 is ("\x{x4E}", chr 0);
61 is ("\x{0065}", chr 101);
62 is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
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");
74 # This caused a memory fault
76 is ("abc", eval qq[qq\x{8000_0000}abc\x{8000_0000}]);
78 # Maybe \x{} should be an error, but if not it should certainly mean \x{0}
79 # rather than anything else.