6 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
8 # Create our test datafile
9 1 while unlink 'foo'; # in case junk left around
11 open TESTFILE, ">./foo" or die "error $! $^E opening";
13 print TESTFILE $teststring;
14 close TESTFILE or die "error $! $^E closing";
16 open TESTFILE, "<./foo";
19 # Check the default $/
21 if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";}
23 # explicitly set to \n
26 if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";}
28 # Try a non line terminator
31 if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";}
33 # Eat the line terminator
37 # How about a larger terminator
40 if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";}
42 # Eat the line terminator
46 # Does paragraph mode work?
49 if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";}
51 # Try slurping the rest of the file
54 if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";}
56 # try the record reading tests. New file so we don't have to worry about
60 open TESTFILE, ">./foo";
61 print TESTFILE "1234567890123456789012345678901234567890";
64 open TESTFILE, "<./foo";
67 # Test straight number
70 if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
72 # Test stringified number
75 if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";}
81 if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";}
87 if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
89 # Naughty straight number - should get the rest of the file
92 if ($bar eq "90123456789012345678901234567890") {print "ok 11\n";} else {print "not ok 11\n";}
96 # Now for the tricky bit--full record reading
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";
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";
110 $throwaway = `\@\[\]foo`, "\n";
111 open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
112 print TEMPFILE "foo\nfoobar\nbaz\n";
115 open TESTFILE, "<./foo.bar";
118 if ($bar eq "foo\n") {print "ok 12\n";} else {print "not ok 12\n";}
120 if ($bar eq "foobar\n") {print "ok 13\n";} else {print "not ok 13\n";}
121 # can we do a short read?
124 if ($bar eq "ba") {print "ok 14\n";} else {print "not ok 14\n";}
125 # do we get the rest of the record?
127 if ($bar eq "z\n") {print "ok 15\n";} else {print "not ok 15\n";}
130 1 while unlink qw(foo.bar foo.com foo.fdl);
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"};
139 # see if open/readline/close work on our and my variables
141 if (open our $T, "./foo") {
144 length($line) == 40 or print "not ";
145 close $T or print "not ";
154 if (open my $T, "./foo") {
157 length($line) == 40 or print "not ";
158 close $T or print "not ";
166 # Get rid of the temp file
167 END { unlink "./foo"; }