This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/IO/t/cachepropagate-unix.t: Add os390 to TODO list
[perl5.git] / lib / DBM_Filter / t / encode.t
1
2 use strict;
3 use warnings;
4 use Carp;
5
6 require "../t/charset_tools.pl";
7
8 BEGIN 
9 {
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
20 require "dbm_filter_util.pl";
21
22 use Test::More tests => 26;
23
24 BEGIN { use_ok('DBM_Filter') };
25 my $db_file;
26 BEGIN {
27     use Config;
28     foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) {
29         if ($Config{extensions} =~ /\b$_\b/) {
30             $db_file = $_;
31             last;
32         }
33     }
34     use_ok($db_file);
35 };
36 BEGIN { use_ok('Fcntl') };
37 BEGIN { use_ok('charnames', qw{greek})};
38
39 use charnames qw{greek};
40
41 unlink <Op_dbmx*>;
42 END { unlink <Op_dbmx*>; }
43
44 my %h1 = () ;
45 my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
46
47 ok $db1, "tied to $db_file";
48
49 eval { $db1->Filter_Push('encode' => 'blah') };
50 like $@, qr/^Encoding 'blah' is not available/, "push an illegal filter" ;
51
52 eval { $db1->Filter_Push('encode') };
53 is $@, '', "push an 'encode' filter (default to utf-8)" ;
54
55
56 {
57     no warnings 'uninitialized';
58     StoreData(\%h1,
59         {       
60                 undef() => undef(),
61                 'alpha' => "\N{alpha}",
62                 "\N{gamma}"=> "gamma",
63                 "beta"  => "\N{beta}",
64         });
65
66 }
67
68 VerifyData(\%h1,
69         {
70                 'alpha' => "\N{alpha}",
71                 "beta"  => "\N{beta}",
72                 "\N{gamma}"=> "gamma",
73                 ""              => "",
74         });
75
76 eval { $db1->Filter_Pop() };
77 is $@, '', "pop the 'utf8' filter" ;
78
79 SKIP: {
80     skip "Encode doesn't currently work for most filters on EBCDIC, including 8859-16", 11 if $::IS_EBCDIC || $::IS_EBCDIC;
81     # Actually the only thing failing below is the euro, because that's the
82     # only thing that's added in 8859-16.
83 eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
84 is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
85
86 use charnames qw{:full};
87 StoreData(\%h1,
88         {       
89                 'euro'  => "\N{EURO SIGN}",
90         });
91
92 undef $db1;
93 {
94     use warnings FATAL => 'untie';
95     eval { untie %h1 };
96     is $@, '', "untie without inner references" ;
97 }
98
99 # read the dbm file without the filter
100 my %h2 = () ;
101 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
102
103 ok $db2, "tied to $db_file";
104
105 VerifyData(\%h2,
106            {
107             'alpha'     => byte_utf8a_to_utf8n("\xCE\xB1"),
108             'beta'      => byte_utf8a_to_utf8n("\xCE\xB2"),
109             byte_utf8a_to_utf8n("\xCE\xB3") => "gamma",
110             'euro'      => uni_to_native("\xA4"),
111             ""          => "",
112            });
113
114 undef $db2;
115 {
116     use warnings FATAL => 'untie';
117     eval { untie %h2 };
118     is $@, '', "untie without inner references" ;
119 }
120
121 }