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
1 #!./perl
2 # Test $!
3
4 print "1..17\n";
5
6 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
7
8 # Create our test datafile
9 1 while unlink 'foo';                # in case junk left around
10 rmdir 'foo';
11 open TESTFILE, ">./foo" or die "error $! $^E opening";
12 binmode TESTFILE;
13 print TESTFILE $teststring;
14 close TESTFILE or die "error $! $^E closing";
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
29 $/ = 3;
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
89 # Naughty straight number - should get the rest of the file
90 $/ = \0;
91 $bar = <TESTFILE>;
92 if ($bar eq "90123456789012345678901234567890") {print "ok 11\n";} else {print "not ok 11\n";}
93
94 close TESTFILE;
95
96 # Now for the tricky bit--full record reading
97 if ($^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.
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";
112   print TEMPFILE "foo\nfoobar\nbaz\n";
113   close TEMPFILE;
114
115   open TESTFILE, "<./foo.bar";
116   $/ = \10;
117   $bar = <TESTFILE>;
118   if ($bar eq "foo\n") {print "ok 12\n";} else {print "not ok 12\n";}
119   $bar = <TESTFILE>;
120   if ($bar eq "foobar\n") {print "ok 13\n";} else {print "not ok 13\n";}
121   # can we do a short read?
122   $/ = \2;
123   $bar = <TESTFILE>;
124   if ($bar eq "ba") {print "ok 14\n";} else {print "not ok 14\n";}
125   # do we get the rest of the record?
126   $bar = <TESTFILE>;
127   if ($bar eq "z\n") {print "ok 15\n";} else {print "not ok 15\n";}
128
129   close TESTFILE;
130   1 while unlink qw(foo.bar foo.com foo.fdl);
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
134   foreach $test (12..15) {print "ok $test # skipped on non-VMS system\n"};
135 }
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     }
150     print "ok 16\n";
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     }
163     print "ok 17\n";
164 }
165
166 # Get rid of the temp file
167 END { unlink "./foo"; }