This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Re: Win32 modules & cygwin
[perl5.git] / 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";