This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sv.c, rs.t, perlvar.pod (Coverity finding: did you know what happens with $/=\0?)
[perl5.git] / t / base / rs.t
CommitLineData
5b2b9c68
HM
1#!./perl
2# Test $!
3
acbd132f 4print "1..17\n";
5b2b9c68
HM
5
6$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
7
8# Create our test datafile
a3318c00
MG
91 while unlink 'foo'; # in case junk left around
10rmdir 'foo';
5b2b9c68
HM
11open TESTFILE, ">./foo" or die "error $! $^E opening";
12binmode TESTFILE;
13print TESTFILE $teststring;
a3b148a7 14close TESTFILE or die "error $! $^E closing";
5b2b9c68
HM
15
16open TESTFILE, "<./foo";
17binmode TESTFILE;
18
19# Check the default $/
20$bar = <TESTFILE>;
21if ($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>;
26if ($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>;
31if ($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>;
40if ($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>;
49if ($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>;
54if ($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.
58close TESTFILE;
59unlink "./foo";
60open TESTFILE, ">./foo";
61print TESTFILE "1234567890123456789012345678901234567890";
62binmode TESTFILE;
63close TESTFILE;
64open TESTFILE, "<./foo";
65binmode TESTFILE;
66
67# Test straight number
68$/ = \2;
69$bar = <TESTFILE>;
70if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
71
72# Test stringified number
73$/ = \"2";
74$bar = <TESTFILE>;
75if ($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>;
81if ($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>;
87if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
88
acbd132f
JH
89# Naughty straight number - should get the rest of the file
90$/ = \0;
91$bar = <TESTFILE>;
92if ($bar eq "90123456789012345678901234567890") {print "ok 11\n";} else {print "not ok 11\n";}
93
7120fed6 94close TESTFILE;
5b2b9c68
HM
95
96# Now for the tricky bit--full record reading
97if ($^O eq 'VMS') {
98 # Create a temp file. We jump through these hoops 'cause CREATE really
99 # doesn't like our methods for some reason.
439f5715
GS
100 open FDLFILE, "> ./foo.fdl";
101 print FDLFILE "RECORD\n FORMAT VARIABLE\n";
102 close FDLFILE;
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";
109 close CREATEFILE;
110 $throwaway = `\@\[\]foo`, "\n";
111 open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
5b2b9c68
HM
112 print TEMPFILE "foo\nfoobar\nbaz\n";
113 close TEMPFILE;
5b2b9c68
HM
114
115 open TESTFILE, "<./foo.bar";
116 $/ = \10;
117 $bar = <TESTFILE>;
acbd132f 118 if ($bar eq "foo\n") {print "ok 12\n";} else {print "not ok 12\n";}
5b2b9c68 119 $bar = <TESTFILE>;
acbd132f 120 if ($bar eq "foobar\n") {print "ok 13\n";} else {print "not ok 13\n";}
5b2b9c68
HM
121 # can we do a short read?
122 $/ = \2;
123 $bar = <TESTFILE>;
acbd132f 124 if ($bar eq "ba") {print "ok 14\n";} else {print "not ok 14\n";}
5b2b9c68
HM
125 # do we get the rest of the record?
126 $bar = <TESTFILE>;
acbd132f 127 if ($bar eq "z\n") {print "ok 15\n";} else {print "not ok 15\n";}
5b2b9c68 128
7120fed6 129 close TESTFILE;
1f47e8e2 130 1 while unlink qw(foo.bar foo.com foo.fdl);
5b2b9c68
HM
131} else {
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
acbd132f 134 foreach $test (12..15) {print "ok $test # skipped on non-VMS system\n"};
5b2b9c68 135}
f558d5af
JH
136
137$/ = "\n";
138
139# see if open/readline/close work on our and my variables
140{
141 if (open our $T, "./foo") {
142 my $line = <$T>;
143 print "# $line\n";
144 length($line) == 40 or print "not ";
145 close $T or print "not ";
146 }
147 else {
148 print "not ";
149 }
acbd132f 150 print "ok 16\n";
f558d5af
JH
151}
152
153{
154 if (open my $T, "./foo") {
155 my $line = <$T>;
156 print "# $line\n";
157 length($line) == 40 or print "not ";
158 close $T or print "not ";
159 }
160 else {
161 print "not ";
162 }
acbd132f 163 print "ok 17\n";
f558d5af
JH
164}
165
166# Get rid of the temp file
167END { unlink "./foo"; }