7 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
8 $teststring2 = "1234567890123456789012345678901234567890";
10 # Create our test datafile
11 1 while unlink 'foo'; # in case junk left around
13 open TESTFILE, ">./foo" or die "error $! $^E opening";
15 print TESTFILE $teststring;
16 close TESTFILE or die "error $! $^E closing";
18 $test_count_start = $test_count; # Needed to know how many tests to skip
19 open TESTFILE, "<./foo";
21 test_string(*TESTFILE);
25 # try the record reading tests. New file so we don't have to worry about
27 open TESTFILE, ">./foo";
28 print TESTFILE $teststring2;
31 open TESTFILE, "<./foo";
33 test_record(*TESTFILE);
35 $test_count_end = $test_count; # Needed to know how many tests to skip
38 # Now for the tricky bit--full record reading
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";
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";
52 $throwaway = `\@\[\]foo`, "\n";
53 open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
54 print TEMPFILE "foo\nfoobar\nbaz\n";
57 open TESTFILE, "<./foo.bar";
60 if ($bar eq "foo\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
63 if ($bar eq "foobar\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
65 # can we do a short read?
68 if ($bar eq "ba") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
70 # do we get the rest of the record?
72 if ($bar eq "z\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
76 1 while unlink qw(foo.bar foo.com foo.fdl);
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";
88 # see if open/readline/close work on our and my variables
90 if (open our $T, "./foo") {
93 length($line) == 40 or print "not ";
94 close $T or print "not ";
99 print "ok $test_count # open/readline/close on our variable\n";
104 if (open my $T, "./foo") {
107 length($line) == 40 or print "not ";
108 close $T or print "not ";
113 print "ok $test_count # open/readline/close on my variable\n";
118 if (not eval q/use PerlIO::scalar; use PerlIO::via::scalar; 1/) {
119 # In-memory files necessitate PerlIO::via::scalar, thus a perl with
120 # perlio and dynaloading enabled. miniperl won't be able to run this
123 # PerlIO::via::scalar has to be tested as well.
124 # use PerlIO::scalar succeeds with ./TEST and with ./perl harness but not with ./perl
126 for $test ($test_count .. $test_count + ($test_count_end - $test_count_start - 1)) {
127 print "ok $test # skipped - Can't test in memory file with miniperl/without PerlIO::Scalar\n";
132 # Test if a file in memory behaves the same as a real file (= re-run the test with a file in memory)
133 open TESTFILE, "<", \$teststring;
134 test_string(*TESTFILE);
137 open TESTFILE, "<", \$teststring2;
138 test_record(*TESTFILE);
142 # Get rid of the temp file
143 END { unlink "./foo"; }
148 # Check the default $/
150 if ($bar ne "1\n") {print "not ";}
151 print "ok $test_count # default \$/\n";
154 # explicitly set to \n
157 if ($bar ne "12\n") {print "not ";}
158 print "ok $test_count # \$/ = \"\\n\"\n";
161 # Try a non line terminator
164 if ($bar ne "123") {print "not ";}
165 print "ok $test_count # \$/ = 3\n";
168 # Eat the line terminator
172 # How about a larger terminator
175 if ($bar ne "1234") {print "not ";}
176 print "ok $test_count # \$/ = \"34\"\n";
179 # Eat the line terminator
183 # Does paragraph mode work?
186 if ($bar ne "1234\n12345\n\n") {print "not ";}
187 print "ok $test_count # \$/ = ''\n";
190 # Try slurping the rest of the file
193 if ($bar ne "123456\n1234567\n") {print "not ";}
194 print "ok $test_count # \$/ = undef\n";
201 # Test straight number
204 if ($bar ne "12") {print "not ";}
205 print "ok $test_count # \$/ = \\2\n";
208 # Test stringified number
211 if ($bar ne "34") {print "not ";}
212 print "ok $test_count # \$/ = \"2\"\n";
219 if ($bar ne "56") {print "not ";}
220 print "ok $test_count # \$/ = \\\$foo (\$foo = 2)\n";
227 if ($bar ne "78") {print "not ";}
228 print "ok $test_count # \$/ = \\\$foo (\$foo = \"2\")\n";
231 # Naughty straight number - should get the rest of the file
234 if ($bar ne "90123456789012345678901234567890") {print "not ";}
235 print "ok $test_count # \$/ = \\0\n";