open.t revision 1.1.1.2
1#!/usr/bin/perl -w 2use strict; 3 4use Test::More 'no_plan'; 5 6use constant NO_SUCH_FILE => "this_file_had_better_not_exist"; 7 8use autodie; 9 10eval { open(my $fh, '<', NO_SUCH_FILE); }; 11ok($@, "3-arg opening non-existent file fails"); 12like($@, qr/for reading/, "Well-formatted 3-arg open failure"); 13 14eval { open(my $fh, "< ".NO_SUCH_FILE) }; 15ok($@, "2-arg opening non-existent file fails"); 16 17like($@, qr/for reading/, "Well-formatted 2-arg open failure"); 18unlike($@, qr/GLOB\(0x/, "No ugly globs in 2-arg open messsage"); 19 20# RT 47520. 2-argument open without mode would repeat the file 21# and line number. 22 23eval { 24 use autodie; 25 26 open(my $fh, NO_SUCH_FILE); 27}; 28 29isa_ok($@, 'autodie::exception'); 30like( $@, qr/at \S+ line \d+/, "At least one mention"); 31unlike($@, qr/at \S+ line \d+\s+at \S+ line \d+/, "...but not too mentions"); 32 33# RT 47520-ish. 2-argument open without a mode should be marked 34# as 'for reading'. 35like($@, qr/for reading/, "Well formatted 2-arg open without mode"); 36 37# We also shouldn't get repeated messages, even if the default mode 38# was used. Single-arg open always falls through to the default 39# formatter. 40 41eval { 42 use autodie; 43 44 open( NO_SUCH_FILE . "" ); 45}; 46 47isa_ok($@, 'autodie::exception'); 48like( $@, qr/at \S+ line \d+/, "At least one mention"); 49unlike($@, qr/at \S+ line \d+\s+at \S+ line \d+/, "...but not too mentions"); 50 51# RT 52427. Piped open can have any many args. 52 53# Sniff to see if we can run 'true' on this system. Changes we can't 54# on non-Unix systems. 55 56eval { 57 use autodie; 58 59 die "Windows and VMS do not support multi-arg pipe" if $^O eq "MSWin32" or $^O eq 'VMS'; 60 61 open(my $fh, '-|', "true"); 62}; 63 64SKIP: { 65 skip('true command or list pipe not available on this system', 1) if $@; 66 67 eval { 68 use autodie; 69 70 my $fh; 71 open $fh, "-|", "true"; 72 open $fh, "-|", "true", "foo"; 73 open $fh, "-|", "true", "foo", "bar"; 74 open $fh, "-|", "true", "foo", "bar", "baz"; 75 }; 76 77 is $@, '', "multi arg piped open does not fail"; 78} 79