3ba66be598c8cfdf57bf1f5c5ed2aa0536596ec1
[perl.git] / ext / GDBM_File / t / fatal.t
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
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
15     plan(tests => 8);
16     use_ok('GDBM_File');
17 }
18
19 unlink <fatal_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', 'fatal_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 <fatal_dbmx*>;