Commit | Line | Data |
---|---|---|
5b2b9c68 HM |
1 | #!./perl |
2 | # Test $! | |
3 | ||
f558d5af | 4 | print "1..16\n"; |
5b2b9c68 HM |
5 | |
6 | $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n"; | |
7 | ||
8 | # Create our test datafile | |
a3318c00 MG |
9 | 1 while unlink 'foo'; # in case junk left around |
10 | rmdir 'foo'; | |
5b2b9c68 HM |
11 | open TESTFILE, ">./foo" or die "error $! $^E opening"; |
12 | binmode TESTFILE; | |
13 | print TESTFILE $teststring; | |
a3b148a7 | 14 | close TESTFILE or die "error $! $^E closing"; |
5b2b9c68 HM |
15 | |
16 | open TESTFILE, "<./foo"; | |
17 | binmode TESTFILE; | |
18 | ||
19 | # Check the default $/ | |
20 | $bar = <TESTFILE>; | |
21 | if ($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>; | |
26 | if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";} | |
27 | ||
28 | # Try a non line terminator | |
af7d13df | 29 | $/ = 3; |
5b2b9c68 HM |
30 | $bar = <TESTFILE>; |
31 | if ($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>; | |
40 | if ($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>; | |
49 | if ($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>; | |
54 | if ($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. | |
58 | close TESTFILE; | |
59 | unlink "./foo"; | |
60 | open TESTFILE, ">./foo"; | |
61 | print TESTFILE "1234567890123456789012345678901234567890"; | |
62 | binmode TESTFILE; | |
63 | close TESTFILE; | |
64 | open TESTFILE, "<./foo"; | |
65 | binmode TESTFILE; | |
66 | ||
67 | # Test straight number | |
68 | $/ = \2; | |
69 | $bar = <TESTFILE>; | |
70 | if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";} | |
71 | ||
72 | # Test stringified number | |
73 | $/ = \"2"; | |
74 | $bar = <TESTFILE>; | |
75 | if ($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>; | |
81 | if ($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>; | |
87 | if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";} | |
88 | ||
7120fed6 | 89 | close TESTFILE; |
5b2b9c68 HM |
90 | |
91 | # Now for the tricky bit--full record reading | |
92 | if ($^O eq 'VMS') { | |
93 | # Create a temp file. We jump through these hoops 'cause CREATE really | |
94 | # doesn't like our methods for some reason. | |
439f5715 GS |
95 | open FDLFILE, "> ./foo.fdl"; |
96 | print FDLFILE "RECORD\n FORMAT VARIABLE\n"; | |
97 | close FDLFILE; | |
98 | open CREATEFILE, "> ./foo.com"; | |
99 | print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n"; | |
100 | print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n"; | |
101 | print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n"; | |
102 | print CREATEFILE '$ CLOSE YOW', "\n"; | |
103 | print CREATEFILE "\$EXIT\n"; | |
104 | close CREATEFILE; | |
105 | $throwaway = `\@\[\]foo`, "\n"; | |
106 | open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n"; | |
5b2b9c68 HM |
107 | print TEMPFILE "foo\nfoobar\nbaz\n"; |
108 | close TEMPFILE; | |
5b2b9c68 HM |
109 | |
110 | open TESTFILE, "<./foo.bar"; | |
111 | $/ = \10; | |
112 | $bar = <TESTFILE>; | |
113 | if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";} | |
114 | $bar = <TESTFILE>; | |
115 | if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";} | |
116 | # can we do a short read? | |
117 | $/ = \2; | |
118 | $bar = <TESTFILE>; | |
119 | if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";} | |
120 | # do we get the rest of the record? | |
121 | $bar = <TESTFILE>; | |
122 | if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";} | |
123 | ||
7120fed6 | 124 | close TESTFILE; |
1f47e8e2 | 125 | 1 while unlink qw(foo.bar foo.com foo.fdl); |
5b2b9c68 HM |
126 | } else { |
127 | # Nobody else does this at the moment (well, maybe OS/390, but they can | |
128 | # put their own tests in) so we just punt | |
129 | foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"}; | |
130 | } | |
f558d5af JH |
131 | |
132 | $/ = "\n"; | |
133 | ||
134 | # see if open/readline/close work on our and my variables | |
135 | { | |
136 | if (open our $T, "./foo") { | |
137 | my $line = <$T>; | |
138 | print "# $line\n"; | |
139 | length($line) == 40 or print "not "; | |
140 | close $T or print "not "; | |
141 | } | |
142 | else { | |
143 | print "not "; | |
144 | } | |
145 | print "ok 15\n"; | |
146 | } | |
147 | ||
148 | { | |
149 | if (open my $T, "./foo") { | |
150 | my $line = <$T>; | |
151 | print "# $line\n"; | |
152 | length($line) == 40 or print "not "; | |
153 | close $T or print "not "; | |
154 | } | |
155 | else { | |
156 | print "not "; | |
157 | } | |
158 | print "ok 16\n"; | |
159 | } | |
160 | ||
161 | # Get rid of the temp file | |
162 | END { unlink "./foo"; } |