1#!./perl 2 3use Config; 4 5BEGIN { 6 if($ENV{PERL_CORE}) { 7 if ($Config{'extensions'} !~ /\bIO\b/) { 8 print "1..0 # Skip: IO extension not built\n"; 9 exit 0; 10 } 11 } 12} 13 14use Test::More tests => 11; 15use IO::File; 16use IO::Seekable; 17 18my $x = IO::File->new_tmpfile(); 19ok($x, "new_tmpfile"); 20print $x "ok 2\n"; 21$x->seek(0,SEEK_SET); 22my $line = <$x>; 23is($line, "ok 2\n", "check we can write to the tempfile"); 24 25$x->seek(0,SEEK_SET); 26print $x "not ok 3\n"; 27my $p = $x->getpos; 28print $x "ok 3\n"; 29$x->flush; 30$x->setpos($p); 31$line = <$x>; 32is($line, "ok 3\n", "test getpos/setpos"); 33 34$! = 0; 35$x->setpos(undef); 36ok($!, "setpos(undef) makes errno non-zero"); 37 38SKIP: 39{ 40 $Config{d_fsync} || $^O eq 'MSWin32' 41 or skip "No fsync", 1; 42 43 ok($x->sync, "sync on a writable handle") 44 or diag "sync(): ", $!; 45} 46 47SKIP: 48{ # [perl #64772] IO::Handle->sync fails on an O_RDONLY descriptor 49 $Config{d_fsync} 50 or skip "No fsync", 1; 51 $^O =~ /^(?:aix|irix)$/ 52 and skip "fsync() documented to fail on non-writable handles on $^O", 1; 53 $^O eq 'cygwin' 54 and skip "fsync() on cygwin uses FlushFileBuffers which requires a writable handle", 1; 55 $^O eq 'VMS' 56 and skip "fsync() not allowed on a read-only handle on $^O", 1; 57 open my $fh, "<", "t/io_xs.t" 58 or skip "Cannot open t/io_xs.t read-only: $!", 1; 59 ok($fh->sync, "sync to a read only handle") 60 or diag "sync(): ", $!; 61} 62 63 64SKIP: { 65 # gh 6799 66 # 67 # This isn't really a Linux/BSD specific test, but /dev/full is (I 68 # hope) reasonably well defined on these. Patches welcome if your platform 69 # also supports it (or something like it) 70 skip "no /dev/full or not a /dev/full platform", 3 71 unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full"; 72 open my $fh, ">", "/dev/full" 73 or skip "Could not open /dev/full: $!", 3; 74 $fh->print("a" x 1024); 75 ok(!$fh->flush, "should fail to flush"); 76 ok($fh->error, "stream should be in error"); 77 $fh->clearerr; 78 ok(!$fh->error, "check clearerr removed the error"); 79 close $fh; # silently ignore the error 80} 81 82{ 83 # [GH #18019] IO::Handle->error misreported an error after successully 84 # opening a regular file for reading. It was a regression in GH #6799 fix. 85 ok(open(my $fh, '<', __FILE__), "a regular file opened for reading"); 86 ok(!$fh->error, "no spurious error reported by error()"); 87 close $fh; 88} 89