1#!./perl 2 3# A modest test: exercises only O_WRONLY, O_CREAT, and O_RDONLY. 4# Have to be modest to be portable: could possibly extend testing 5# also to O_RDWR and O_APPEND, but dunno about the portability of, 6# say, O_TRUNC and O_EXCL, not to mention O_NONBLOCK. 7 8use Fcntl; 9 10print "1..7\n"; 11 12print "ok 1\n"; 13 14if (sysopen(my $wo, "fcntl$$", O_WRONLY|O_CREAT)) { 15 binmode $wo; 16 print "ok 2\n"; 17 if (syswrite($wo, "foo") == 3) { 18 print "ok 3\n"; 19 close($wo); 20 if (sysopen(my $ro, "fcntl$$", O_RDONLY)) { 21 binmode $ro; 22 print "ok 4\n"; 23 if (sysread($ro, my $read, 3)) { 24 print "ok 5\n"; 25 if ($read eq "foo") { 26 print "ok 6\n"; 27 } else { 28 print "not ok 6 # content '$read' not ok\n"; 29 } 30 } else { 31 print "not ok 5 # sysread failed: $!\n"; 32 } 33 } else { 34 print "not ok 4 # sysopen O_RDONLY failed: $!\n"; 35 } 36 close($ro); 37 } else { 38 print "not ok 3 # syswrite failed: $!\n"; 39 } 40 close($wo); 41} else { 42 print "not ok 2 # sysopen O_WRONLY failed: $!\n"; 43} 44 45# Opening of character special devices gets special treatment in doio.c 46# Didn't work as of perl-5.8.0-RC2. 47use File::Spec; # To portably get /dev/null 48 49my $devnull = File::Spec->devnull; 50if (-c $devnull) { 51 if (sysopen(my $wo, $devnull, O_WRONLY)) { 52 print "ok 7 # open /dev/null O_WRONLY\n"; 53 close($wo); 54 } 55 else { 56 print "not ok 7 # open /dev/null O_WRONLY\n"; 57 } 58} 59else { 60 print "ok 7 # Skipping /dev/null sysopen O_WRONLY test\n"; 61} 62 63END { 64 1 while unlink "fcntl$$"; 65} 66