1#!./perl 2# Test $! 3 4print "1..17\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 or die "error $! $^E closing"; 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# Naughty straight number - should get the rest of the file 90$/ = \0; 91$bar = <TESTFILE>; 92if ($bar eq "90123456789012345678901234567890") {print "ok 11\n";} else {print "not ok 11\n";} 93 94close TESTFILE; 95 96# Now for the tricky bit--full record reading 97if ($^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 167END { unlink "./foo"; } 168