Commit | Line | Data |
---|---|---|
ceab7011 NC |
1 | #!./perl -w |
2 | use strict; | |
3 | ||
4 | use Test::More; | |
5 | use Config; | |
6 | ||
7 | BEGIN { | |
8 | plan(skip_all => "GDBM_File was not built") | |
9 | unless $Config{extensions} =~ /\bGDBM_File\b/; | |
10 | ||
cfc6b1ed JH |
11 | # https://rt.perl.org/Public/Bug/Display.html?id=117967 |
12 | plan(skip_all => "GDBM_File is flaky in $^O") | |
13 | if $^O =~ /darwin/; | |
14 | ||
ceab7011 NC |
15 | plan(tests => 8); |
16 | use_ok('GDBM_File'); | |
17 | } | |
18 | ||
19 | unlink <Op_dbmx*>; | |
20 | ||
21 | open my $fh, $^X or die "Can't open $^X: $!"; | |
22 | my $fileno = fileno $fh; | |
23 | isnt($fileno, undef, "Can find next available file descriptor"); | |
24 | close $fh or die $!; | |
25 | ||
26 | is((open $fh, "<&=$fileno"), undef, | |
27 | "Check that we cannot open fileno $fileno. \$! is $!"); | |
28 | ||
29 | umask(0); | |
30 | my %h; | |
31 | isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); | |
32 | ||
33 | isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno") | |
34 | or diag("\$! = $!"); | |
35 | isnt(close $fh, undef, | |
36 | "close fileno $fileno, out from underneath the GDBM_File"); | |
37 | is(eval { | |
38 | $h{Perl} = 'Rules'; | |
39 | untie %h; | |
40 | 1; | |
41 | }, undef, 'Trapped error when attempting to write to knobbled GDBM_File'); | |
42 | ||
43 | # Observed "File write error" and "lseek error" from two different systems. | |
44 | # So there might be more variants. Important part was that we trapped the error | |
45 | # via croak. | |
46 | like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/, | |
47 | 'expected error message from GDBM_File'); | |
48 | ||
49 | unlink <Op_dbmx*>; |