t/base/rs.t

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