191f110e0Safresh1#!./perl 291f110e0Safresh1 391f110e0Safresh1BEGIN { 491f110e0Safresh1 chdir 't' if -d 't'; 591f110e0Safresh1 @INC = '../lib'; 691f110e0Safresh1} 791f110e0Safresh1 891f110e0Safresh1# This file uses a specially crafted is() function rather than that found in 991f110e0Safresh1# t/test.pl or Test::More. Hence, we place this file in directory t/opbasic. 1091f110e0Safresh1 11*eac174f2Safresh1print q(1..30 1291f110e0Safresh1); 1391f110e0Safresh1 1491f110e0Safresh1# This is() function is written to avoid "" 1591f110e0Safresh1my $test = 1; 1691f110e0Safresh1sub is { 1791f110e0Safresh1 my($left, $right) = @_; 1891f110e0Safresh1 1991f110e0Safresh1 if ($left eq $right) { 2091f110e0Safresh1 printf 'ok %d 2191f110e0Safresh1', $test++; 2291f110e0Safresh1 return 1; 2391f110e0Safresh1 } 2491f110e0Safresh1 foreach ($left, $right) { 2591f110e0Safresh1 # Comment out these regexps to map non-printables to ord if the perl under 2691f110e0Safresh1 # test is so broken that it is not helping 2791f110e0Safresh1 s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge; 2891f110e0Safresh1 $_ = sprintf q('%s'), $_; 2991f110e0Safresh1 s/^''\.//; 3091f110e0Safresh1 s/\.''$//; 3191f110e0Safresh1 } 3291f110e0Safresh1 printf q(not ok %d - got %s expected %s 3391f110e0Safresh1), $test++, $left, $right; 3491f110e0Safresh1 3591f110e0Safresh1 printf q(# Failed test at line %d 3691f110e0Safresh1), (caller)[2]; 3791f110e0Safresh1 3891f110e0Safresh1 return 0; 3991f110e0Safresh1} 4091f110e0Safresh1 4191f110e0Safresh1is ("\x53", chr 83); 4291f110e0Safresh1is ("\x4EE", chr (78) . 'E'); 4391f110e0Safresh1is ("\x4i", chr (4) . 'i'); # This will warn 4491f110e0Safresh1is ("\xh", chr (0) . 'h'); # This will warn 4591f110e0Safresh1is ("\xx", chr (0) . 'x'); # This will warn 4691f110e0Safresh1is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too? 4791f110e0Safresh1is ("\x9_E", chr (9) . '_E'); # This will warn 4891f110e0Safresh1 4991f110e0Safresh1is ("\x{4E}", chr 78); 50*eac174f2Safresh1is ("\x{ 4E }", chr 78); 5191f110e0Safresh1is ("\x{6_9}", chr 105); 5291f110e0Safresh1is ("\x{_6_3}", chr 99); 5391f110e0Safresh1is ("\x{_6B}", chr 107); 5491f110e0Safresh1 5591f110e0Safresh1is ("\x{9__0}", chr 9); # multiple underscores not allowed. 5691f110e0Safresh1is ("\x{77_}", chr 119); # trailing underscore warns. 5791f110e0Safresh1is ("\x{6FQ}z", chr (111) . 'z'); 5891f110e0Safresh1 5991f110e0Safresh1is ("\x{0x4E}", chr 0); 6091f110e0Safresh1is ("\x{x4E}", chr 0); 6191f110e0Safresh1 6291f110e0Safresh1is ("\x{0065}", chr 101); 6391f110e0Safresh1is ("\x{000000000000000000000000000000000000000000000000000000000000000072}", 6491f110e0Safresh1 chr 114); 6591f110e0Safresh1is ("\x{0_06_5}", chr 101); 6691f110e0Safresh1is ("\x{1234}", chr 4660); 6791f110e0Safresh1is ("\x{10FFFD}", chr 1114109); 6891f110e0Safresh1is ("\400", chr 0x100); 6991f110e0Safresh1is ("\600", chr 0x180); 7091f110e0Safresh1is ("\777", chr 0x1FF); 7191f110e0Safresh1is ("a\o{120}b", "a" . chr(0x50) . "b"); 72*eac174f2Safresh1is ("a\o{ 120 }b", "a" . chr(0x50) . "b"); 7391f110e0Safresh1is ("a\o{400}b", "a" . chr(0x100) . "b"); 7491f110e0Safresh1is ("a\o{1000}b", "a" . chr(0x200) . "b"); 7591f110e0Safresh1 76b8851fccSafresh1# Maybe \x{} should be an error, but if not it should certainly mean \x{0} 77b8851fccSafresh1# rather than anything else. 78b8851fccSafresh1is ("\x{}", chr(0)); 79