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