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 BEGIN { use_ok('SDBM_File') };
  12 BEGIN { use_ok('Fcntl') };
  13
  14 unlink <Op_dbmx*>;
  15 END { unlink <Op_dbmx*>; }
  16
  17 my %h1 = () ;
  18 my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  19
  20 ok $db1, "tied to SDBM_File";
  21
  22 # store before adding the filter
  23
  24 StoreData(\%h1,
  25         {
  26                 1234    => 5678,
  27                 -3      => -5,
  28                 "22"    => "88",
  29                 "-45"   => "-88",
  30         });
  31
  32 VerifyData(\%h1,
  33         {
  34                 1234    => 5678,
  35                 -3      => -5,
  36                 22      => 88,
  37                 -45     => -88,
  38         });
  39
  40
  41 eval { $db1->Filter_Push('int32') };
  42 is $@, '', "push an 'int32' filter" ;
  43
  44 {
  45     no warnings 'uninitialized';
  46     StoreData(\%h1,
  47         {
  48                 undef() => undef(),
  49                 "400"   => "500",
  50                 0       => 1,
  51                 1       => 0,
  52                 -47     => -6,
  53         });
  54
  55 }
  56
  57 undef $db1;
  58 {
  59     use warnings FATAL => 'untie';
  60     eval { untie %h1 };
  61     is $@, '', "untie without inner references" ;
  62 }
  63
  64 # read the dbm file without the filter
  65 my %h2 = () ;
  66 my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  67
  68 ok $db2, "tied to SDBM_File";
  69
  70 VerifyData(\%h2,
  71         {
  72                 1234    => 5678,
  73                 -3      => -5,
  74                 22      => 88,
  75                 -45     => -88,
  76
  77                 #undef()        => undef(),
  78                 pack("i", 400)  => pack("i", 500),
  79                 pack("i", 0)    => pack("i", 1),
  80                 pack("i", 1)    => pack("i", 0),
  81                 pack("i", -47)  => pack("i", -6),
  82         });
  83
  84 undef $db2;
  85 {
  86     use warnings FATAL => 'untie';
  87     eval { untie %h2 };
  88     is $@, '', "untie without inner references" ;
  89 }
  90