dist/IO/t/io_xs.t

   1 #!./perl
   2
   3 use Config;
   4
   5 BEGIN {
   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
  14 use Test::More tests => 5;
  15 use IO::File;
  16 use IO::Seekable;
  17
  18 $x = new_tmpfile IO::File;
  19 ok($x, "new_tmpfile");
  20 print $x "ok 2\n";
  21 $x->seek(0,SEEK_SET);
  22 my $line = <$x>;
  23 is($line, "ok 2\n", "check we can write to the tempfile");
  24
  25 $x->seek(0,SEEK_SET);
  26 print $x "not ok 3\n";
  27 $p = $x->getpos;
  28 print $x "ok 3\n";
  29 $x->flush;
  30 $x->setpos($p);
  31 $line = <$x>;
  32 is($line, "ok 3\n", "test getpos/setpos");
  33
  34 $! = 0;
  35 $x->setpos(undef);
  36 ok($!, "setpos(undef) makes errno non-zero");
  37
  38 SKIP:
  39 { # [perl #64772] IO::Handle->sync fails on an O_RDONLY descriptor
  40     $Config{d_fsync}
  41        or skip "No fsync", 1;
  42     $^O =~ /^(?:aix|irix)$/
  43       and skip "fsync() documented to fail on non-writable handles on $^O", 1;
  44     $^O eq 'cygwin'
  45       and skip "fsync() on cygwin uses FlushFileBuffers which requires a writable handle", 1;
  46     open my $fh, "<", "t/io_xs.t"
  47        or skip "Cannot open t/io_xs.t read-only: $!", 1;
  48     ok($fh->sync, "sync to a read only handle")
  49         or diag "sync(): ", $!;
  50 }