t/op/sysio.t

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