1256a93a4Safresh1#!./perl -w 2256a93a4Safresh1use strict; 3256a93a4Safresh1 4256a93a4Safresh1use Test::More; 5256a93a4Safresh1use Config; 6256a93a4Safresh1use File::Temp 'tempdir'; 7256a93a4Safresh1use File::Spec; 8256a93a4Safresh1 9256a93a4Safresh1BEGIN { 10256a93a4Safresh1 plan(skip_all => "GDBM_File was not built") 11256a93a4Safresh1 unless $Config{extensions} =~ /\bGDBM_File\b/; 12256a93a4Safresh1 13256a93a4Safresh1 # https://rt.perl.org/Public/Bug/Display.html?id=117967 14256a93a4Safresh1 plan(skip_all => "GDBM_File is flaky in $^O") 15256a93a4Safresh1 if $^O =~ /darwin/; 16256a93a4Safresh1 17*f2a19305Safresh1 plan(tests => 9); 18256a93a4Safresh1 use_ok('GDBM_File'); 19256a93a4Safresh1} 20256a93a4Safresh1 21256a93a4Safresh1my $wd = tempdir(CLEANUP => 1); 22256a93a4Safresh1my $dbname = File::Spec->catfile($wd, 'Op_dbmx'); 23256a93a4Safresh1my %h; 24256a93a4Safresh1my $db = tie(%h, 'GDBM_File', $dbname, GDBM_WRCREAT, 0640); 25256a93a4Safresh1isa_ok($db, 'GDBM_File'); 26256a93a4Safresh1SKIP: { 27256a93a4Safresh1 my $name = eval { $db->dbname } or do { 28*f2a19305Safresh1 skip "gdbm_setopt GET calls not implemented", 7 29256a93a4Safresh1 if $@ =~ /GDBM_File::dbname not implemented/; 30256a93a4Safresh1 }; 31256a93a4Safresh1 is($db->dbname, $dbname, 'get dbname'); 32256a93a4Safresh1 is(eval { $db->dbname("a"); }, undef, 'dbname - bad usage'); 33256a93a4Safresh1 is($db->flags, GDBM_WRCREAT, 'get flags'); 34256a93a4Safresh1 is($db->sync_mode, 0, 'get sync_mode'); 35256a93a4Safresh1 is($db->sync_mode(1), 1, 'set sync_mode'); 36256a93a4Safresh1 is($db->sync_mode, 1, 'get sync_mode'); 37*f2a19305Safresh1 SKIP: { 38*f2a19305Safresh1 my ($maj, $min) = GDBM_File->GDBM_version; 39*f2a19305Safresh1 skip "gdbm too old", 1 if $maj != 1 || $maj == 1 && $min < 9; 40*f2a19305Safresh1 isnt($db->mmapsize, 0, "get mmapsize"); 41*f2a19305Safresh1 } 42256a93a4Safresh1} 43