lib/DBM_Filter/t/int32.t

   1
   2 use strict;
   3 use warnings;
   4 use Carp;
   5
   6 require "dbm_filter_util.pl";
   7
   8 use Test::More tests => 22;
   9
  10 BEGIN { use_ok('DBM_Filter') };
  11 my $db_file;
  12 BEGIN {
  13     use Config;
  14     foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) {
  15         if ($Config{extensions} =~ /\b$_\b/) {
  16             $db_file = $_;
  17             last;
  18         }
  19     }
  20     use_ok($db_file);
  21 };
  22 BEGIN { use_ok('Fcntl') };
  23
  24 unlink <Op_dbmx*>;
  25 END { unlink <Op_dbmx*>; }
  26
  27 my %h1 = () ;
  28 my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  29
  30 ok $db1, "tied to $db_file";
  31
  32 # store before adding the filter
  33
  34 StoreData(\%h1,
  35         {
  36                 1234    => 5678,
  37                 -3      => -5,
  38                 "22"    => "88",
  39                 "-45"   => "-88",
  40         });
  41
  42 VerifyData(\%h1,
  43         {
  44                 1234    => 5678,
  45                 -3      => -5,
  46                 22      => 88,
  47                 -45     => -88,
  48         });
  49
  50
  51 eval { $db1->Filter_Push('int32') };
  52 is $@, '', "push an 'int32' filter" ;
  53
  54 {
  55     no warnings 'uninitialized';
  56     StoreData(\%h1,
  57         {
  58                 undef() => undef(),
  59                 "400"   => "500",
  60                 0       => 1,
  61                 1       => 0,
  62                 -47     => -6,
  63         });
  64
  65 }
  66
  67 undef $db1;
  68 {
  69     use warnings FATAL => 'untie';
  70     eval { untie %h1 };
  71     is $@, '', "untie without inner references" ;
  72 }
  73
  74 # read the dbm file without the filter
  75 my %h2 = () ;
  76 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  77
  78 ok $db2, "tied to $db_file";
  79
  80 VerifyData(\%h2,
  81         {
  82                 1234    => 5678,
  83                 -3      => -5,
  84                 22      => 88,
  85                 -45     => -88,
  86
  87                 #undef()        => undef(),
  88                 pack("i", 400)  => pack("i", 500),
  89                 pack("i", 0)    => pack("i", 1),
  90                 pack("i", 1)    => pack("i", 0),
  91                 pack("i", -47)  => pack("i", -6),
  92         });
  93
  94 undef $db2;
  95 {
  96     use warnings FATAL => 'untie';
  97     eval { untie %h2 };
  98     is $@, '', "untie without inner references" ;
  99 }
 100