ext/Win32API-File/t/tie.t

   1 #!perl
   2 # vim:syntax=perl:
   3
   4 BEGIN {
   5     $|= 1;
   6
   7     # when building perl, skip this test if Win32API::File isn't being built
   8     if ( $ENV{PERL_CORE} ) {
   9         require Config;
  10         if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {
  11             print "1..0 # Skip Win32API::File extension not built\n";
  12             exit();
  13         }
  14     }
  15
  16     print "1..10\n";
  17 }
  18 END   { print "not ok 1\n" unless $main::loaded; }
  19
  20 use strict;
  21 use warnings;
  22 use Win32API::File qw(:ALL);
  23 use IO::File;
  24
  25 $main::loaded = 1;
  26
  27 print "ok 1\n";
  28
  29 unlink "foo.txt";
  30
  31 my $fh = new Win32API::File "+> foo.txt"
  32         or die fileLastError();
  33
  34 my $tell = tell $fh;
  35 print "# tell \$fh == '$tell'\n";
  36 print "not " unless
  37         tell $fh == 0;
  38 print "ok 2\n";
  39
  40 my $text = "some text\n";
  41
  42 print "not " unless
  43         print $fh $text;
  44 print "ok 3\n";
  45
  46 $tell = tell $fh;
  47 print "# after printing 'some text\\n', tell is: '$tell'\n";
  48 print "not " unless
  49         $tell == length($text) + 1;
  50 print "ok 4\n";
  51
  52 print "not " unless
  53         seek($fh, 0, 0) == 0;
  54 print "ok 5\n";
  55
  56 print "not " unless
  57         not eof $fh;
  58 print "ok 6\n";
  59
  60 my $readline = <$fh>;
  61
  62 my $pretty_readline = $readline;
  63 $pretty_readline =~ s/\r/\\r/g;  $pretty_readline =~ s/\n/\\n/g;
  64 print "# read line is '$pretty_readline'\n";
  65
  66 print "not " unless
  67         $readline eq "some text\r\n";
  68 print "ok 7\n";
  69
  70 print "not " unless
  71         eof $fh;
  72 print "ok 8\n";
  73
  74 print "not " unless
  75         close $fh;
  76 print "ok 9\n";
  77
  78 # Test out binmode (should be only LF with print, no CR).
  79
  80 $fh = new Win32API::File "+> foo.txt"
  81         or die fileLastError();
  82 binmode $fh;
  83 print $fh "hello there\n";
  84 seek $fh, 0, 0;
  85
  86 print "not " unless
  87         <$fh> eq "hello there\n";
  88 print "ok 10\n";
  89
  90 close $fh;
  91
  92 unlink "foo.txt";