1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
#!./perl
# Test $!
print "1..14\n";
$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
# Create our test datafile
open TESTFILE, ">./foo" or die "error $! $^E opening";
binmode TESTFILE;
print TESTFILE $teststring;
close TESTFILE;
open TESTFILE, "<./foo";
binmode TESTFILE;
# Check the default $/
$bar = <TESTFILE>;
if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";}
# explicitly set to \n
$/ = "\n";
$bar = <TESTFILE>;
if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";}
# Try a non line terminator
$/ = "3";
$bar = <TESTFILE>;
if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";}
# Eat the line terminator
$/ = "\n";
$bar = <TESTFILE>;
# How about a larger terminator
$/ = "34";
$bar = <TESTFILE>;
if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";}
# Eat the line terminator
$/ = "\n";
$bar = <TESTFILE>;
# Does paragraph mode work?
$/ = '';
$bar = <TESTFILE>;
if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";}
# Try slurping the rest of the file
$/ = undef;
$bar = <TESTFILE>;
if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";}
# try the record reading tests. New file so we don't have to worry about
# the size of \n.
close TESTFILE;
unlink "./foo";
open TESTFILE, ">./foo";
print TESTFILE "1234567890123456789012345678901234567890";
binmode TESTFILE;
close TESTFILE;
open TESTFILE, "<./foo";
binmode TESTFILE;
# Test straight number
$/ = \2;
$bar = <TESTFILE>;
if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
# Test stringified number
$/ = \"2";
$bar = <TESTFILE>;
if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";}
# Integer variable
$foo = 2;
$/ = \$foo;
$bar = <TESTFILE>;
if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";}
# String variable
$foo = "2";
$/ = \$foo;
$bar = <TESTFILE>;
if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
# Get rid of the temp file
unlink "./foo";
# Now for the tricky bit--full record reading
if ($^O eq 'VMS') {
# Create a temp file. We jump through these hoops 'cause CREATE really
# doesn't like our methods for some reason.
open FDLFILE, "> ./foo.fdl";
print FDLFILE "RECORD\n FORMAT VARIABLE\n";
close FDLFILE;
open CREATEFILE, "> ./foo.com";
print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n";
print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n";
print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n";
print CREATEFILE '$ CLOSE YOW', "\n";
print CREATEFILE "\$EXIT\n";
close CREATEFILE;
$throwaway = `\@\[\]foo`, "\n";
open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
print TEMPFILE "foo\nfoobar\nbaz\n";
close TEMPFILE;
open TESTFILE, "<./foo.bar";
$/ = \10;
$bar = <TESTFILE>;
if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";}
$bar = <TESTFILE>;
if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";}
# can we do a short read?
$/ = \2;
$bar = <TESTFILE>;
if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";}
# do we get the rest of the record?
$bar = <TESTFILE>;
if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";}
unlink "./foo.bar";
unlink "./foo.com";
} else {
# Nobody else does this at the moment (well, maybe OS/390, but they can
# put their own tests in) so we just punt
foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
}
|
