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