syswrite does not block other writers

5553595.pl

use strict;
use warnings;

my $blk_size = 6000;
my $num_blks = 20;

sub work {
   my ($ch) = @_;
   my $blk = $ch x $blk_size;
   for (1..$num_blks) {
      open(my $fh, '>>', 'file') or die $!;
      my $rv = syswrite($fh, $blk) or die $!;
      die("Partial write") if $rv != $blk_size;
   }
}

sub child {
   if (eval { &work; 1 }) {
      exit(0);
   } else {
      print(STDERR $@);
      exit($! || $? || 255);
   }
}

waitpid($_, 0) for map { fork || child($_) } 0..9;

{
   open(my $fh, '<', 'file') or die $!;
   local $/ = \(1024*64);
   my $last = '';
   my $count = 0;
   while (<$fh>) {
      for (split //) {
         if ($_ ne $last || $count == $blk_size) {
            print("$last: $count\n") if $count;
            $last = $_;
            $count = 0;       
         }

         ++$count;
      }
   }    

   print("$last: $count\n") if $count;
}

__END__
$ perl a.pl | grep -v 6000
0: 4000
2: 4000
1: 4000
2: 4000
1: 4000
2: 4000
0: 2000
6: 4000
7: 4000
8: 4000
^C