t/13_setpack.t

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