home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / base / rs.t < prev    next >
Text File  |  1999-07-20  |  3KB  |  131 lines
  1. #!./perl
  2. # Test $!
  3.  
  4. print "1..14\n";
  5.  
  6. $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
  7.  
  8. # Create our test datafile
  9. open TESTFILE, ">./foo" or die "error $! $^E opening";
  10. binmode TESTFILE;
  11. print TESTFILE $teststring;
  12. close TESTFILE;
  13.  
  14. open TESTFILE, "<./foo";
  15. binmode TESTFILE;
  16.  
  17. # Check the default $/
  18. $bar = <TESTFILE>;
  19. if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";}
  20.  
  21. # explicitly set to \n
  22. $/ = "\n";
  23. $bar = <TESTFILE>;
  24. if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";}
  25.  
  26. # Try a non line terminator
  27. $/ = 3;
  28. $bar = <TESTFILE>;
  29. if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";}
  30.  
  31. # Eat the line terminator
  32. $/ = "\n";
  33. $bar = <TESTFILE>;
  34.  
  35. # How about a larger terminator
  36. $/ = "34";
  37. $bar = <TESTFILE>;
  38. if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";}
  39.  
  40. # Eat the line terminator
  41. $/ = "\n";
  42. $bar = <TESTFILE>;
  43.  
  44. # Does paragraph mode work?
  45. $/ = '';
  46. $bar = <TESTFILE>;
  47. if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";}
  48.  
  49. # Try slurping the rest of the file
  50. $/ = undef;
  51. $bar = <TESTFILE>;
  52. if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";}
  53.  
  54. # try the record reading tests. New file so we don't have to worry about
  55. # the size of \n.
  56. close TESTFILE;
  57. unlink "./foo";
  58. open TESTFILE, ">./foo";
  59. print TESTFILE "1234567890123456789012345678901234567890";
  60. binmode TESTFILE;
  61. close TESTFILE;
  62. open TESTFILE, "<./foo";
  63. binmode TESTFILE;
  64.  
  65. # Test straight number
  66. $/ = \2;
  67. $bar = <TESTFILE>;
  68. if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
  69.  
  70. # Test stringified number
  71. $/ = \"2";
  72. $bar = <TESTFILE>;
  73. if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";}
  74.  
  75. # Integer variable
  76. $foo = 2;
  77. $/ = \$foo;
  78. $bar = <TESTFILE>;
  79. if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";}
  80.  
  81. # String variable
  82. $foo = "2";
  83. $/ = \$foo;
  84. $bar = <TESTFILE>;
  85. if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
  86.  
  87. # Get rid of the temp file
  88. close TESTFILE;
  89. unlink "./foo";
  90.  
  91. # Now for the tricky bit--full record reading
  92. if ($^O eq 'VMS') {
  93.   # Create a temp file. We jump through these hoops 'cause CREATE really
  94.   # doesn't like our methods for some reason.
  95.   open FDLFILE, "> ./foo.fdl";
  96.   print FDLFILE "RECORD\n FORMAT VARIABLE\n";
  97.   close FDLFILE;
  98.   open CREATEFILE, "> ./foo.com";
  99.   print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n";
  100.   print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n";
  101.   print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n";
  102.   print CREATEFILE '$ CLOSE YOW', "\n";
  103.   print CREATEFILE "\$EXIT\n";
  104.   close CREATEFILE;
  105.   $throwaway = `\@\[\]foo`, "\n";
  106.   open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
  107.   print TEMPFILE "foo\nfoobar\nbaz\n";
  108.   close TEMPFILE;
  109.  
  110.   open TESTFILE, "<./foo.bar";
  111.   $/ = \10;
  112.   $bar = <TESTFILE>;
  113.   if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";}
  114.   $bar = <TESTFILE>;
  115.   if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";}
  116.   # can we do a short read?
  117.   $/ = \2;
  118.   $bar = <TESTFILE>;
  119.   if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";}
  120.   # do we get the rest of the record?
  121.   $bar = <TESTFILE>;
  122.   if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";}
  123.  
  124.   close TESTFILE;
  125.   1 while unlink qw(foo.bar foo.com foo.fdl);
  126. } else {
  127.   # Nobody else does this at the moment (well, maybe OS/390, but they can
  128.   # put their own tests in) so we just punt
  129.   foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
  130. }
  131.