This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regenerate known_pod_issues.dat
[perl5.git] / t / base / rs.t
CommitLineData
5b2b9c68
HM
1#!./perl
2# Test $!
3
4dafff08 4print "1..28\n";
5b2b9c68 5
4dafff08 6$test_count = 1;
5b2b9c68 7$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
4dafff08 8$teststring2 = "1234567890123456789012345678901234567890";
5b2b9c68
HM
9
10# Create our test datafile
a3318c00
MG
111 while unlink 'foo'; # in case junk left around
12rmdir 'foo';
5b2b9c68
HM
13open TESTFILE, ">./foo" or die "error $! $^E opening";
14binmode TESTFILE;
15print TESTFILE $teststring;
a3b148a7 16close TESTFILE or die "error $! $^E closing";
5b2b9c68 17
4dafff08 18$test_count_start = $test_count; # Needed to know how many tests to skip
5b2b9c68
HM
19open TESTFILE, "<./foo";
20binmode TESTFILE;
4dafff08
B
21test_string(*TESTFILE);
22close TESTFILE;
23unlink "./foo";
5b2b9c68
HM
24
25# try the record reading tests. New file so we don't have to worry about
26# the size of \n.
5b2b9c68 27open TESTFILE, ">./foo";
4dafff08 28print TESTFILE $teststring2;
5b2b9c68
HM
29binmode TESTFILE;
30close TESTFILE;
31open TESTFILE, "<./foo";
32binmode TESTFILE;
4dafff08 33test_record(*TESTFILE);
7120fed6 34close TESTFILE;
4dafff08
B
35$test_count_end = $test_count; # Needed to know how many tests to skip
36
5b2b9c68
HM
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.
439f5715
GS
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";
5b2b9c68
HM
54 print TEMPFILE "foo\nfoobar\nbaz\n";
55 close TEMPFILE;
5b2b9c68
HM
56
57 open TESTFILE, "<./foo.bar";
58 $/ = \10;
59 $bar = <TESTFILE>;
4dafff08
B
60 if ($bar eq "foo\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
61 $test_count++;
5b2b9c68 62 $bar = <TESTFILE>;
4dafff08
B
63 if ($bar eq "foobar\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
64 $test_count++;
5b2b9c68
HM
65 # can we do a short read?
66 $/ = \2;
67 $bar = <TESTFILE>;
4dafff08
B
68 if ($bar eq "ba") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
69 $test_count++;
5b2b9c68
HM
70 # do we get the rest of the record?
71 $bar = <TESTFILE>;
4dafff08
B
72 if ($bar eq "z\n") {print "ok $test_count\n";} else {print "not ok $test_count\n";}
73 $test_count++;
5b2b9c68 74
7120fed6 75 close TESTFILE;
1f47e8e2 76 1 while unlink qw(foo.bar foo.com foo.fdl);
5b2b9c68
HM
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
4dafff08
B
80 foreach $test ($test_count..$test_count + 3) {
81 print "ok $test # skipped on non-VMS system\n";
82 $test_count++;
83 }
5b2b9c68 84}
f558d5af
JH
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 }
4dafff08
B
99 print "ok $test_count # open/readline/close on our variable\n";
100 $test_count++;
f558d5af
JH
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 }
4dafff08
B
113 print "ok $test_count # open/readline/close on my variable\n";
114 $test_count++;
115}
116
117
20c00210
FC
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/) {
4dafff08
B
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
cd1a9f55
B
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
4dafff08 131 for $test ($test_count .. $test_count + ($test_count_end - $test_count_start - 1)) {
24ead163 132 print "ok $test # skipped - Can't test in memory file with miniperl/without PerlIO::Scalar\n";
4dafff08
B
133 $test_count++;
134 }
20c00210
FC
135 }
136 else {
4dafff08
B
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;
20c00210 145 }
f558d5af
JH
146}
147
148# Get rid of the temp file
149END { unlink "./foo"; }
4dafff08
B
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