t/13_setpack.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Config;
   6 use Test::More tests => 10;
   7 use t::common qw( new_fh );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 my ($default, $small, $medium, $large);
  12
  13 {
  14     my ($fh, $filename) = new_fh();
  15     my $db = DBM::Deep->new(
  16         file => $filename,
  17         autoflush => 1,
  18     );
  19     $db->{key1} = "value1";
  20     $db->{key2} = "value2";
  21     $default = (stat($filename))[7];
  22 }
  23
  24 {
  25     my ($fh, $filename) = new_fh();
  26     {
  27         my $db = DBM::Deep->new(
  28             file => $filename,
  29             autoflush => 1,
  30             pack_size => 'medium',
  31         );
  32
  33         $db->{key1} = "value1";
  34         $db->{key2} = "value2";
  35         $medium = (stat($filename))[7];
  36     }
  37
  38     # This tests the header to verify that the pack_size is really there
  39     {
  40         my $db = DBM::Deep->new(
  41             file => $filename,
  42         );
  43
  44         is( $db->{key1}, 'value1', 'Can read key1' );
  45         is( $db->{key2}, 'value2', 'Can read key2' );
  46     }
  47
  48     cmp_ok( $medium, '==', $default, "The default is medium" );
  49 }
  50
  51 {
  52     my ($fh, $filename) = new_fh();
  53     {
  54         my $db = DBM::Deep->new(
  55             file => $filename,
  56             autoflush => 1,
  57             pack_size => 'small',
  58         );
  59
  60         $db->{key1} = "value1";
  61         $db->{key2} = "value2";
  62         $small = (stat($filename))[7];
  63     }
  64
  65     # This tests the header to verify that the pack_size is really there
  66     {
  67         my $db = DBM::Deep->new(
  68             file => $filename,
  69         );
  70
  71         is( $db->{key1}, 'value1', 'Can read key1' );
  72         is( $db->{key2}, 'value2', 'Can read key2' );
  73     }
  74
  75     cmp_ok( $medium, '>', $small, "medium is greater than small" );
  76 }
  77
  78 eval "pack('Q', 0);";
  79 my $haveQ = !$@;
  80
  81 SKIP: {
  82     skip "Largefile support is not compiled into $^X", 3
  83         unless $haveQ;
  84
  85     my ($fh, $filename) = new_fh();
  86     {
  87         my $db = DBM::Deep->new(
  88             file => $filename,
  89             autoflush => 1,
  90             pack_size => 'large',
  91         );
  92
  93         $db->{key1} = "value1";
  94         $db->{key2} = "value2";
  95         $large = (stat($filename))[7];
  96     }
  97
  98     # This tests the header to verify that the pack_size is really there
  99     {
 100         my $db = DBM::Deep->new(
 101             file => $filename,
 102         );
 103
 104         is( $db->{key1}, 'value1', 'Can read key1' );
 105         is( $db->{key2}, 'value2', 'Can read key2' );
 106     }
 107     cmp_ok( $medium, '<', $large, "medium is smaller than large" );
 108 }
 109
 110 #SKIP: {
 111 #    skip "Largefile support is compiled into $^X", 3
 112 #        if $haveQ;
 113 #
 114 #    my ($fh, $filename) = new_fh();
 115 #    {
 116 #        my $db = DBM::Deep->new(
 117 #            file => $filename,
 118 #            autoflush => 1,
 119 #            pack_size => 'large',
 120 #        );
 121 #    }
 122 #
 123 #}