1#!./perl 2# Test $! 3 4print "1..14\n"; 5 6$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n"; 7 8# Create our test datafile 91 while unlink 'foo'; # in case junk left around 10rmdir 'foo'; 11open TESTFILE, ">./foo" or die "error $! $^E opening"; 12binmode TESTFILE; 13print TESTFILE $teststring; 14close TESTFILE; 15 16open TESTFILE, "<./foo"; 17binmode TESTFILE; 18 19# Check the default $/ 20$bar = <TESTFILE>; 21if ($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>; 26if ($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>; 31if ($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>; 40if ($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>; 49if ($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>; 54if ($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. 58close TESTFILE; 59unlink "./foo"; 60open TESTFILE, ">./foo"; 61print TESTFILE "1234567890123456789012345678901234567890"; 62binmode TESTFILE; 63close TESTFILE; 64open TESTFILE, "<./foo"; 65binmode TESTFILE; 66 67# Test straight number 68$/ = \2; 69$bar = <TESTFILE>; 70if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";} 71 72# Test stringified number 73$/ = \"2"; 74$bar = <TESTFILE>; 75if ($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>; 81if ($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>; 87if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";} 88 89# Get rid of the temp file 90close TESTFILE; 91unlink "./foo"; 92 93# Now for the tricky bit--full record reading 94if ($^O eq 'VMS') { 95 # Create a temp file. We jump through these hoops 'cause CREATE really 96 # doesn't like our methods for some reason. 97 open FDLFILE, "> ./foo.fdl"; 98 print FDLFILE "RECORD\n FORMAT VARIABLE\n"; 99 close FDLFILE; 100 open CREATEFILE, "> ./foo.com"; 101 print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n"; 102 print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n"; 103 print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n"; 104 print CREATEFILE '$ CLOSE YOW', "\n"; 105 print CREATEFILE "\$EXIT\n"; 106 close CREATEFILE; 107 $throwaway = `\@\[\]foo`, "\n"; 108 open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n"; 109 print TEMPFILE "foo\nfoobar\nbaz\n"; 110 close TEMPFILE; 111 112 open TESTFILE, "<./foo.bar"; 113 $/ = \10; 114 $bar = <TESTFILE>; 115 if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";} 116 $bar = <TESTFILE>; 117 if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";} 118 # can we do a short read? 119 $/ = \2; 120 $bar = <TESTFILE>; 121 if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";} 122 # do we get the rest of the record? 123 $bar = <TESTFILE>; 124 if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";} 125 126 close TESTFILE; 127 1 while unlink qw(foo.bar foo.com foo.fdl); 128} else { 129 # Nobody else does this at the moment (well, maybe OS/390, but they can 130 # put their own tests in) so we just punt 131 foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"}; 132} 133