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