Commit | Line | Data |
5b2b9c68 |
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 |
af7d13df |
27 | $/ = 3; |
5b2b9c68 |
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 |
7120fed6 |
88 | close TESTFILE; |
5b2b9c68 |
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. |
439f5715 |
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"; |
5b2b9c68 |
107 | print TEMPFILE "foo\nfoobar\nbaz\n"; |
108 | close TEMPFILE; |
5b2b9c68 |
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 | |
7120fed6 |
124 | close TESTFILE; |
644a2880 |
125 | 1 while unlink qw(foo.bar foo.com foo.fdl); |
5b2b9c68 |
126 | } else { |
127 | # Nobody else does this at the moment (well, maybe OS/390, but they can |
128 | # put their own tests in) so we just punt |
129 | foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"}; |
130 | } |