xref: /openbsd/gnu/usr.bin/perl/cpan/autodie/t/truncate.t (revision 8932bfb7)
1#!/usr/bin/perl -w
2use strict;
3
4use Test::More;
5use File::Temp qw(tempfile);
6use IO::Handle;
7
8my $tmpfh = tempfile();
9my $truncate_status;
10
11eval {
12    $truncate_status = truncate($tmpfh, 0);
13};
14
15if ($@ || !defined($truncate_status)) {
16    plan skip_all => 'Truncate not implemented or not working on this system';
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");
54