1#!./perl 2# Test $! 3 4print "1..28\n"; 5 6$test_count = 1; 7$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n"; 8$teststring2 = "1234567890123456789012345678901234567890"; 9 10# Create our test datafile 111 while unlink 'foo'; # in case junk left around 12rmdir 'foo'; 13open TESTFILE, ">./foo" or die "error $! $^E opening"; 14binmode TESTFILE; 15print TESTFILE $teststring; 16close TESTFILE or die "error $! $^E closing"; 17 18$test_count_start = $test_count; # Needed to know how many tests to skip 19open TESTFILE, "<./foo"; 20binmode TESTFILE; 21test_string(*TESTFILE); 22close TESTFILE; 23unlink "./foo"; 24 25# try the record reading tests. New file so we don't have to worry about 26# the size of \n. 27open TESTFILE, ">./foo"; 28print TESTFILE $teststring2; 29binmode TESTFILE; 30close TESTFILE; 31open TESTFILE, "<./foo"; 32binmode TESTFILE; 33test_record(*TESTFILE); 34close TESTFILE; 35$test_count_end = $test_count; # Needed to know how many tests to skip 36 37 38# Now for the tricky bit--full record reading 39if ($^O eq 'VMS') { 40 # Create a temp file. We jump through these hoops 'cause CREATE really 41 # doesn't like our methods for some reason. 42 open FDLFILE, "> ./foo.fdl"; 43 print FDLFILE "RECORD\n FORMAT VARIABLE\n"; 44 close FDLFILE; 45 open CREATEFILE, "> ./foo.com"; 46 print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n"; 47 print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n"; 48 print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n"; 49 print CREATEFILE '$ CLOSE YOW', "\n"; 50 print CREATEFILE "\$EXIT\n"; 51 close CREATEFILE; 52 $throwaway = `\@\[\]foo`, "\n"; 53 open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n"; 54 print TEMPFILE "foo\nfoobar\nbaz\n"; 55 close TEMPFILE; 56 57 open TESTFILE, "<./foo.bar"; 58 $/ = \10; 59 $bar = <TESTFILE>; 60 if ($bar eq "foo\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";} 61 $test_count++; 62 $bar = <TESTFILE>; 63 if ($bar eq "foobar\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";} 64 $test_count++; 65 # can we do a short read? 66 $/ = \2; 67 $bar = <TESTFILE>; 68 if ($bar eq "ba") {print "ok $test_count\n";} else {print "not ok $test_count\n";} 69 $test_count++; 70 # do we get the rest of the record? 71 $bar = <TESTFILE>; 72 if ($bar eq "z\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";} 73 $test_count++; 74 75 close TESTFILE; 76 1 while unlink qw(foo.bar foo.com foo.fdl); 77} else { 78 # Nobody else does this at the moment (well, maybe OS/390, but they can 79 # put their own tests in) so we just punt 80 foreach $test ($test_count..$test_count + 3) { 81 print "ok $test # skipped on non-VMS system\n"; 82 $test_count++; 83 } 84} 85 86$/ = "\n"; 87 88# see if open/readline/close work on our and my variables 89{ 90 if (open our $T, "./foo") { 91 my $line = <$T>; 92 print "# $line\n"; 93 length($line) == 40 or print "not "; 94 close $T or print "not "; 95 } 96 else { 97 print "not "; 98 } 99 print "ok $test_count # open/readline/close on our variable\n"; 100 $test_count++; 101} 102 103{ 104 if (open my $T, "./foo") { 105 my $line = <$T>; 106 print "# $line\n"; 107 length($line) == 40 or print "not "; 108 close $T or print "not "; 109 } 110 else { 111 print "not "; 112 } 113 print "ok $test_count # open/readline/close on my variable\n"; 114 $test_count++; 115} 116 117 118{ 119 # If we do not include the lib directories, we may end up picking up a 120 # binary-incompatible previously-installed version. The eval won’t help in 121 # intercepting a SIGTRAP. 122 local @INC = ("../lib", "lib", @INC); 123 if (not eval q/use PerlIO::scalar; use PerlIO::via::scalar; 1/) { 124 # In-memory files necessitate PerlIO::via::scalar, thus a perl with 125 # perlio and dynaloading enabled. miniperl won't be able to run this 126 # test, so skip it 127 128 # PerlIO::via::scalar has to be tested as well. 129 # use PerlIO::scalar succeeds with ./TEST and with ./perl harness but not with ./perl 130 131 for $test ($test_count .. $test_count + ($test_count_end - $test_count_start - 1)) { 132 print "ok $test # skipped - Can't test in memory file with miniperl/without PerlIO::Scalar\n"; 133 $test_count++; 134 } 135 } 136 else { 137 # Test if a file in memory behaves the same as a real file (= re-run the test with a file in memory) 138 open TESTFILE, "<", \$teststring; 139 test_string(*TESTFILE); 140 close TESTFILE; 141 142 open TESTFILE, "<", \$teststring2; 143 test_record(*TESTFILE); 144 close TESTFILE; 145 } 146} 147 148# Get rid of the temp file 149END { unlink "./foo"; } 150 151sub test_string { 152 *FH = shift; 153 154 # Check the default $/ 155 $bar = <FH>; 156 if ($bar ne "1\n") {print "not ";} 157 print "ok $test_count # default \$/\n"; 158 $test_count++; 159 160 # explicitly set to \n 161 $/ = "\n"; 162 $bar = <FH>; 163 if ($bar ne "12\n") {print "not ";} 164 print "ok $test_count # \$/ = \"\\n\"\n"; 165 $test_count++; 166 167 # Try a non line terminator 168 $/ = 3; 169 $bar = <FH>; 170 if ($bar ne "123") {print "not ";} 171 print "ok $test_count # \$/ = 3\n"; 172 $test_count++; 173 174 # Eat the line terminator 175 $/ = "\n"; 176 $bar = <FH>; 177 178 # How about a larger terminator 179 $/ = "34"; 180 $bar = <FH>; 181 if ($bar ne "1234") {print "not ";} 182 print "ok $test_count # \$/ = \"34\"\n"; 183 $test_count++; 184 185 # Eat the line terminator 186 $/ = "\n"; 187 $bar = <FH>; 188 189 # Does paragraph mode work? 190 $/ = ''; 191 $bar = <FH>; 192 if ($bar ne "1234\n12345\n\n") {print "not ";} 193 print "ok $test_count # \$/ = ''\n"; 194 $test_count++; 195 196 # Try slurping the rest of the file 197 $/ = undef; 198 $bar = <FH>; 199 if ($bar ne "123456\n1234567\n") {print "not ";} 200 print "ok $test_count # \$/ = undef\n"; 201 $test_count++; 202} 203 204sub test_record { 205 *FH = shift; 206 207 # Test straight number 208 $/ = \2; 209 $bar = <FH>; 210 if ($bar ne "12") {print "not ";} 211 print "ok $test_count # \$/ = \\2\n"; 212 $test_count++; 213 214 # Test stringified number 215 $/ = \"2"; 216 $bar = <FH>; 217 if ($bar ne "34") {print "not ";} 218 print "ok $test_count # \$/ = \"2\"\n"; 219 $test_count++; 220 221 # Integer variable 222 $foo = 2; 223 $/ = \$foo; 224 $bar = <FH>; 225 if ($bar ne "56") {print "not ";} 226 print "ok $test_count # \$/ = \\\$foo (\$foo = 2)\n"; 227 $test_count++; 228 229 # String variable 230 $foo = "2"; 231 $/ = \$foo; 232 $bar = <FH>; 233 if ($bar ne "78") {print "not ";} 234 print "ok $test_count # \$/ = \\\$foo (\$foo = \"2\")\n"; 235 $test_count++; 236 237 # Naughty straight number - should get the rest of the file 238 $/ = \0; 239 $bar = <FH>; 240 if ($bar ne "90123456789012345678901234567890") {print "not ";} 241 print "ok $test_count # \$/ = \\0\n"; 242 $test_count++; 243} 244 245