xref: /openbsd-src/gnu/usr.bin/perl/t/base/rs.t (revision 0a5f61bb653fdff7c29c2275df78c7f019a04c0c) 
1#!./perl
2# Test $!
3
4print "1..14\n";
5
6$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
7
8# Create our test datafile
9open TESTFILE, ">./foo" or die "error $! $^E opening";
10binmode TESTFILE;
11print TESTFILE $teststring;
12close TESTFILE;
13
14open TESTFILE, "<./foo";
15binmode TESTFILE;
16
17# Check the default $/
18$bar = <TESTFILE>;
19if ($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>;
24if ($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>;
29if ($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>;
38if ($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>;
47if ($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>;
52if ($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.
56close TESTFILE;
57unlink "./foo";
58open TESTFILE, ">./foo";
59print TESTFILE "1234567890123456789012345678901234567890";
60binmode TESTFILE;
61close TESTFILE;
62open TESTFILE, "<./foo";
63binmode TESTFILE;
64
65# Test straight number
66$/ = \2;
67$bar = <TESTFILE>;
68if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
69
70# Test stringified number
71$/ = \"2";
72$bar = <TESTFILE>;
73if ($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>;
79if ($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>;
85if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
86
87# Get rid of the temp file
88close TESTFILE;
89unlink "./foo";
90
91# Now for the tricky bit--full record reading
92if ($^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}
132