This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update the Change log in Module::CoreList to include recent commits
[perl5.git] / cpan / autodie / t / truncate.t
CommitLineData
0b09a93a
PF
1#!/usr/bin/perl -w
2use strict;
3
4use Test::More;
5use File::Temp qw(tempfile);
6use IO::Handle;
7
8my $tmpfh = tempfile();
3776a202 9my $truncate_status;
0b09a93a
PF
10
11eval {
3776a202 12 $truncate_status = truncate($tmpfh, 0);
0b09a93a
PF
13};
14
3776a202
PF
15if ($@ || !defined($truncate_status)) {
16 plan skip_all => 'Truncate not implemented or not working on this system';
0b09a93a
PF
17}
18
19plan tests => 3;
20
21SKIP: {
22 my $can_truncate_stdout = truncate(\*STDOUT,0);
23
24 if ($can_truncate_stdout) {
25 skip("This system thinks we can truncate STDOUT. Suuure!", 1);
26 }
27
28 eval {
29 use autodie;
30 truncate(\*STDOUT,0);
31 };
32
33 isa_ok($@, 'autodie::exception', "Truncating STDOUT should throw an exception");
34
35}
36
37eval {
38 use autodie;
39 no warnings 'once';
40 truncate(\*FOO, 0);
41};
42
43isa_ok($@, 'autodie::exception', "Truncating an unopened file is wrong.");
44
45$tmpfh->print("Hello World");
46$tmpfh->flush;
47
48eval {
49 use autodie;
50 truncate($tmpfh, 0);
51};
52
53is($@, "", "Truncating a normal file should be fine");