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