t/op/sysio.t

   1 #!./perl
   2
   3 print "1..39\n";
   4
   5 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
   6
   7 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
   8
   9 $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' ||
  10            $^O eq 'mpeix');
  11
  12 $x = 'abc';
  13
  14 # should not be able to do negative lengths
  15 eval { sysread(I, $x, -1) };
  16 print 'not ' unless ($@ =~ /^Negative length /);
  17 print "ok 1\n";
  18
  19 # $x should be intact
  20 print 'not ' unless ($x eq 'abc');
  21 print "ok 2\n";
  22
  23 # should not be able to read before the buffer
  24 eval { sysread(I, $x, 1, -4) };
  25 print 'not ' unless ($x eq 'abc');
  26 print "ok 3\n";
  27
  28 # $x should be intact
  29 print 'not ' unless ($x eq 'abc');
  30 print "ok 4\n";
  31
  32 $a ='0123456789';
  33
  34 # default offset 0
  35 print 'not ' unless(sysread(I, $a, 3) == 3);
  36 print "ok 5\n";
  37
  38 # $a should be as follows
  39 print 'not ' unless ($a eq '#!.');
  40 print "ok 6\n";
  41
  42 # reading past the buffer should zero pad
  43 print 'not ' unless(sysread(I, $a, 2, 5) == 2);
  44 print "ok 7\n";
  45
  46 # the zero pad should be seen now
  47 print 'not ' unless ($a eq "#!.\0\0/p");
  48 print "ok 8\n";
  49
  50 # try changing the last two characters of $a
  51 print 'not ' unless(sysread(I, $a, 3, -2) == 3);
  52 print "ok 9\n";
  53
  54 # the last two characters of $a should have changed (into three)
  55 print 'not ' unless ($a eq "#!.\0\0erl");
  56 print "ok 10\n";
  57
  58 $outfile = 'sysio.out';
  59
  60 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
  61
  62 select(O); $|=1; select(STDOUT);
  63
  64 # cannot write negative lengths
  65 eval { syswrite(O, $x, -1) };
  66 print 'not ' unless ($@ =~ /^Negative length /);
  67 print "ok 11\n";
  68
  69 # $x still intact
  70 print 'not ' unless ($x eq 'abc');
  71 print "ok 12\n";
  72
  73 # $outfile still intact
  74 print 'not ' if (-s $outfile);
  75 print "ok 13\n";
  76
  77 # should not be able to write from after the buffer
  78 eval { syswrite(O, $x, 1, 3) };
  79 print 'not ' unless ($@ =~ /^Offset outside string /);
  80 print "ok 14\n";
  81
  82 # $x still intact
  83 print 'not ' unless ($x eq 'abc');
  84 print "ok 15\n";
  85
  86 # $outfile still intact
  87 if ($reopen) {  # must close file to update EOF marker for stat
  88   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
  89 }
  90 print 'not ' if (-s $outfile);
  91 print "ok 16\n";
  92
  93 # should not be able to write from before the buffer
  94
  95 eval { syswrite(O, $x, 1, -4) };
  96 print 'not ' unless ($@ =~ /^Offset outside string /);
  97 print "ok 17\n";
  98
  99 # $x still intact
 100 print 'not ' unless ($x eq 'abc');
 101 print "ok 18\n";
 102
 103 # $outfile still intact
 104 if ($reopen) {  # must close file to update EOF marker for stat
 105   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
 106 }
 107 print 'not ' if (-s $outfile);
 108 print "ok 19\n";
 109
 110 # default offset 0
 111 print 'not ' unless (syswrite(O, $a, 2) == 2);
 112 print "ok 20\n";
 113
 114 # $a still intact
 115 print 'not ' unless ($a eq "#!.\0\0erl");
 116 print "ok 21\n";
 117
 118 # $outfile should have grown now
 119 if ($reopen) {  # must close file to update EOF marker for stat
 120   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
 121 }
 122 print 'not ' unless (-s $outfile == 2);
 123 print "ok 22\n";
 124
 125 # with offset
 126 print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
 127 print "ok 23\n";
 128
 129 # $a still intact
 130 print 'not ' unless ($a eq "#!.\0\0erl");
 131 print "ok 24\n";
 132
 133 # $outfile should have grown now
 134 if ($reopen) {  # must close file to update EOF marker for stat
 135   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
 136 }
 137 print 'not ' unless (-s $outfile == 4);
 138 print "ok 25\n";
 139
 140 # with negative offset and a bit too much length
 141 print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
 142 print "ok 26\n";
 143
 144 # $a still intact
 145 print 'not ' unless ($a eq "#!.\0\0erl");
 146 print "ok 27\n";
 147
 148 # $outfile should have grown now
 149 if ($reopen) {  # must close file to update EOF marker for stat
 150   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
 151 }
 152 print 'not ' unless (-s $outfile == 7);
 153 print "ok 28\n";
 154
 155 # with implicit length argument
 156 print 'not ' unless (syswrite(O, $x) == 3);
 157 print "ok 29\n";
 158
 159 # $a still intact
 160 print 'not ' unless ($x eq "abc");
 161 print "ok 30\n";
 162
 163 # $outfile should have grown now
 164 if ($reopen) {  # must close file to update EOF marker for stat
 165   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
 166 }
 167 print 'not ' unless (-s $outfile == 10);
 168 print "ok 31\n";
 169
 170 close(O);
 171
 172 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
 173
 174 $b = 'xyz';
 175
 176 # reading too much only return as much as available
 177 print 'not ' unless (sysread(I, $b, 100) == 10);
 178 print "ok 32\n";
 179 # this we should have
 180 print 'not ' unless ($b eq '#!ererlabc');
 181 print "ok 33\n";
 182
 183 # test sysseek
 184
 185 print 'not ' unless sysseek(I, 2, 0) == 2;
 186 print "ok 34\n";
 187 sysread(I, $b, 3);
 188 print 'not ' unless $b eq 'ere';
 189 print "ok 35\n";
 190
 191 print 'not ' unless sysseek(I, -2, 1) == 3;
 192 print "ok 36\n";
 193 sysread(I, $b, 4);
 194 print 'not ' unless $b eq 'rerl';
 195 print "ok 37\n";
 196
 197 print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
 198 print "ok 38\n";
 199 print 'not ' if defined sysseek(I, -1, 1);
 200 print "ok 39\n";
 201
 202 close(I);
 203
 204 unlink $outfile;
 205
 206 chdir('..');
 207
 208 1;
 209
 210 # eof