lib/DBM_Filter/t/utf8.t

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