This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Win32API-File to CPAN version 0.1200
[perl5.git] / cpan / Win32API-File / t / tie.t
CommitLineData
00701878
SH
1#!perl
2# vim:syntax=perl:
3
57d226e4
YST
4BEGIN {
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}
00701878
SH
18END { print "not ok 1\n" unless $main::loaded; }
19
20use strict;
21use warnings;
22use Win32API::File qw(:ALL);
23use IO::File;
24
25$main::loaded = 1;
26
27print "ok 1\n";
28
29unlink "foo.txt";
30
00f02a57 31my $fh = Win32API::File->new("+> foo.txt")
00701878
SH
32 or die fileLastError();
33
34my $tell = tell $fh;
35print "# tell \$fh == '$tell'\n";
36print "not " unless
37 tell $fh == 0;
38print "ok 2\n";
39
40my $text = "some text\n";
41
42print "not " unless
43 print $fh $text;
44print "ok 3\n";
45
46$tell = tell $fh;
47print "# after printing 'some text\\n', tell is: '$tell'\n";
48print "not " unless
49 $tell == length($text) + 1;
50print "ok 4\n";
51
52print "not " unless
53 seek($fh, 0, 0) == 0;
54print "ok 5\n";
55
56print "not " unless
57 not eof $fh;
58print "ok 6\n";
59
60my $readline = <$fh>;
61
62my $pretty_readline = $readline;
63$pretty_readline =~ s/\r/\\r/g; $pretty_readline =~ s/\n/\\n/g;
64print "# read line is '$pretty_readline'\n";
65
66print "not " unless
67 $readline eq "some text\r\n";
68print "ok 7\n";
69
70print "not " unless
71 eof $fh;
72print "ok 8\n";
73
74print "not " unless
75 close $fh;
76print "ok 9\n";
77
78# Test out binmode (should be only LF with print, no CR).
79
00f02a57 80$fh = Win32API::File->new("+> foo.txt")
00701878
SH
81 or die fileLastError();
82binmode $fh;
83print $fh "hello there\n";
84seek $fh, 0, 0;
85
86print "not " unless
87 <$fh> eq "hello there\n";
88print "ok 10\n";
89
90close $fh;
91
92unlink "foo.txt";