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*>;