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