This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/DBM_Filter/t/encode.t: TODO a test on EBCDIC
[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 {
69     local $TODO = "Currently broken on EBCDIC" if $::IS_EBCDIC;
70     VerifyData(\%h1,
71         {
72                 'alpha' => "\N{alpha}",
73                 "beta"  => "\N{beta}",
74                 "\N{gamma}"=> "gamma",
75                 ""              => "",
76         });
77 }
78
79 eval { $db1->Filter_Pop() };
80 is $@, '', "pop the 'utf8' filter" ;
81
82 SKIP: {
83     skip "Encode doesn't currently work for most filters on EBCDIC, including 8859-16", 11 if $::IS_EBCDIC || $::IS_EBCDIC;
84     # Actually the only thing failing below is the euro, because that's the
85     # only thing that's added in 8859-16.
86 eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
87 is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
88
89 use charnames qw{:full};
90 StoreData(\%h1,
91         {       
92                 'euro'  => "\N{EURO SIGN}",
93         });
94
95 undef $db1;
96 {
97     use warnings FATAL => 'untie';
98     eval { untie %h1 };
99     is $@, '', "untie without inner references" ;
100 }
101
102 # read the dbm file without the filter
103 my %h2 = () ;
104 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
105
106 ok $db2, "tied to $db_file";
107
108 VerifyData(\%h2,
109            {
110             'alpha'     => byte_utf8a_to_utf8n("\xCE\xB1"),
111             'beta'      => byte_utf8a_to_utf8n("\xCE\xB2"),
112             byte_utf8a_to_utf8n("\xCE\xB3") => "gamma",
113             'euro'      => uni_to_native("\xA4"),
114             ""          => "",
115            });
116
117 undef $db2;
118 {
119     use warnings FATAL => 'untie';
120     eval { untie %h2 };
121     is $@, '', "untie without inner references" ;
122 }
123
124 }