t/base/rs.t

   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 }