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 print "ok 2\n"; 16 if (syswrite($wo, "foo") == 3) { 17 print "ok 3\n"; 18 close($wo); 19 if (sysopen(my $ro, "fcntl$$", O_RDONLY)) { 20 print "ok 4\n"; 21 if (sysread($ro, my $read, 3)) { 22 print "ok 5\n"; 23 if ($read eq "foo") { 24 print "ok 6\n"; 25 } else { 26 print "not ok 6 # content '$read' not ok\n"; 27 } 28 } else { 29 print "not ok 5 # sysread failed: $!\n"; 30 } 31 } else { 32 print "not ok 4 # sysopen O_RDONLY failed: $!\n"; 33 } 34 close($ro); 35 } else { 36 print "not ok 3 # syswrite failed: $!\n"; 37 } 38 close($wo); 39} else { 40 print "not ok 2 # sysopen O_WRONLY failed: $!\n"; 41} 42 43# Opening of character special devices gets special treatment in doio.c 44# Didn't work as of perl-5.8.0-RC2. 45use File::Spec; # To portably get /dev/null 46 47my $devnull = File::Spec->devnull; 48if (-c $devnull) { 49 if (sysopen(my $wo, $devnull, O_WRONLY)) { 50 print "ok 7 # open /dev/null O_WRONLY\n"; 51 close($wo); 52 } 53 else { 54 print "not ok 7 # open /dev/null O_WRONLY\n"; 55 } 56} 57else { 58 print "ok 7 # Skipping /dev/null sysopen O_WRONLY test\n"; 59} 60 61END { 62 1 while unlink "fcntl$$"; 63} 64