summaryrefslogtreecommitdiff
path: root/cpan/autodie/t/open.t
blob: 359eb9a9f26198a67d25b43af2dd282cd519f054 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#!/usr/bin/perl -w
use strict;

use Test::More 'no_plan';

use constant NO_SUCH_FILE => "this_file_had_better_not_exist";

use autodie;

eval { open(my $fh, '<', NO_SUCH_FILE); };
ok($@, "3-arg opening non-existent file fails");
like($@, qr/for reading/, "Well-formatted 3-arg open failure");

eval { open(my $fh, "< ".NO_SUCH_FILE) };
ok($@, "2-arg opening non-existent file fails");

like($@, qr/for reading/, "Well-formatted 2-arg open failure");
unlike($@, qr/GLOB\(0x/, "No ugly globs in 2-arg open messsage");

# RT 47520.  2-argument open without mode would repeat the file
# and line number.

eval {
    use autodie;

    open(my $fh, NO_SUCH_FILE);
};

isa_ok($@, 'autodie::exception');
like(  $@, qr/at \S+ line \d+/, "At least one mention");
unlike($@, qr/at \S+ line \d+\s+at \S+ line \d+/, "...but not too mentions");

# RT 47520-ish.  2-argument open without a mode should be marked
# as 'for reading'.
like($@, qr/for reading/, "Well formatted 2-arg open without mode");

# We also shouldn't get repeated messages, even if the default mode
# was used.  Single-arg open always falls through to the default
# formatter.

eval {
    use autodie;

    open( NO_SUCH_FILE . "" );
};

isa_ok($@, 'autodie::exception');
like(  $@, qr/at \S+ line \d+/, "At least one mention");
unlike($@, qr/at \S+ line \d+\s+at \S+ line \d+/, "...but not too mentions");

# RT 52427.  Piped open can have any many args.

# Sniff to see if we can run 'true' on this system.  Changes we can't
# on non-Unix systems.

eval {
    use autodie;

    die "Windows does not support multi-arg pipe" if $^O eq "MSWin32";

    open(my $fh, '-|', "true");
};

SKIP: {
    skip('true command or list pipe not available on this system', 1) if $@;

    eval {
        use autodie;

        my $fh;
        open $fh, "-|", "true";
        open $fh, "-|", "true", "foo";
        open $fh, "-|", "true", "foo", "bar";
        open $fh, "-|", "true", "foo", "bar", "baz";
    };

    is $@, '', "multi arg piped open does not fail";
}