This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
close() open files before unlink()
[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 close TESTFILE;
89 unlink "./foo";
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.
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";
107   print TEMPFILE "foo\nfoobar\nbaz\n";
108   close TEMPFILE;
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
124   close TESTFILE;
125   unlink "./foo.bar";
126   unlink "./foo.com";  
127 } else {
128   # Nobody else does this at the moment (well, maybe OS/390, but they can
129   # put their own tests in) so we just punt
130   foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
131 }