This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b60fbb54e04a653cd34fd1927204d392eaaa4b18
[perl5.git] / lib / DBM_Filter / t / encode.t
1
2 use strict;
3 use warnings;
4 use Carp;
5
6
7 BEGIN 
8 {
9
10     eval { require Encode; };
11     
12     if ($@) {
13         print "1..0 #  Skip: Encode is not available\n";
14         exit 0;
15     }
16 }
17
18
19 require "dbm_filter_util.pl";
20
21 use Test::More tests => 26;
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('encode' => 'blah') };
49 like $@, qr/^Encoding 'blah' is not available/, "push an illigal filter" ;
50
51 eval { $db1->Filter_Push('encode') };
52 is $@, '', "push an 'encode' filter (default to utf-8)" ;
53
54
55 {
56     no warnings 'uninitialized';
57     StoreData(\%h1,
58         {       
59                 undef() => undef(),
60                 'alpha' => "\N{alpha}",
61                 "\N{gamma}"=> "gamma",
62                 "beta"  => "\N{beta}",
63         });
64
65 }
66
67 VerifyData(\%h1,
68         {
69                 'alpha' => "\N{alpha}",
70                 "beta"  => "\N{beta}",
71                 "\N{gamma}"=> "gamma",
72                 ""              => "",
73         });
74
75 eval { $db1->Filter_Pop() };
76 is $@, '', "pop the 'utf8' filter" ;
77
78 eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
79 is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
80
81 use charnames qw{:full};
82 StoreData(\%h1,
83         {       
84                 'euro'  => "\N{EURO SIGN}",
85         });
86
87 undef $db1;
88 {
89     use warnings FATAL => 'untie';
90     eval { untie %h1 };
91     is $@, '', "untie without inner references" ;
92 }
93
94 # read the dbm file without the filter
95 my %h2 = () ;
96 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
97
98 ok $db2, "tied to $db_file";
99
100 if (ord('A') == 193) { # EBCDIC.
101     VerifyData(\%h2,
102            {
103             'alpha'     => "\xB4\x58",
104             'beta'      => "\xB4\x59",
105             "\xB4\x62"=> "gamma",               
106             "\x65\x75\x72\x6F" => "\xA4",                           
107             ""          => "",
108            });
109 } else {
110     VerifyData(\%h2,
111            {
112             'alpha'     => "\xCE\xB1",
113             'beta'      => "\xCE\xB2",
114             "\xCE\xB3"=> "gamma",
115             'euro'      => "\xA4",
116             ""          => "",
117            });
118 }
119
120 undef $db2;
121 {
122     use warnings FATAL => 'untie';
123     eval { untie %h2 };
124     is $@, '', "untie without inner references" ;
125 }
126