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
CommitLineData
0e9b1cbd
PM
1
2use strict;
3use warnings;
4use Carp;
5
2e90857c 6require "../t/charset_tools.pl";
0e9b1cbd
PM
7
8BEGIN
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
20require "dbm_filter_util.pl";
21
22use Test::More tests => 26;
23
24BEGIN { use_ok('DBM_Filter') };
e8ebc68a
JH
25my $db_file;
26BEGIN {
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};
0e9b1cbd
PM
36BEGIN { use_ok('Fcntl') };
37BEGIN { use_ok('charnames', qw{greek})};
38
39use charnames qw{greek};
40
41unlink <Op_dbmx*>;
42END { unlink <Op_dbmx*>; }
43
44my %h1 = () ;
e8ebc68a 45my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
0e9b1cbd 46
e8ebc68a 47ok $db1, "tied to $db_file";
0e9b1cbd
PM
48
49eval { $db1->Filter_Push('encode' => 'blah') };
c3a085ec 50like $@, qr/^Encoding 'blah' is not available/, "push an illegal filter" ;
0e9b1cbd
PM
51
52eval { $db1->Filter_Push('encode') };
53is $@, '', "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
c47eeaa0
KW
68{
69 local $TODO = "Currently broken on EBCDIC" if $::IS_EBCDIC;
70 VerifyData(\%h1,
0e9b1cbd
PM
71 {
72 'alpha' => "\N{alpha}",
73 "beta" => "\N{beta}",
74 "\N{gamma}"=> "gamma",
75 "" => "",
76 });
c47eeaa0 77}
0e9b1cbd
PM
78
79eval { $db1->Filter_Pop() };
80is $@, '', "pop the 'utf8' filter" ;
81
fc962064
KW
82SKIP: {
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.
0e9b1cbd
PM
86eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
87is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
88
89use charnames qw{:full};
90StoreData(\%h1,
91 {
92 'euro' => "\N{EURO SIGN}",
93 });
94
95undef $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
103my %h2 = () ;
e8ebc68a 104my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
0e9b1cbd 105
e8ebc68a 106ok $db2, "tied to $db_file";
0e9b1cbd 107
2e90857c 108VerifyData(\%h2,
2f3efc97 109 {
2e90857c
KW
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"),
2f3efc97
JH
114 "" => "",
115 });
0e9b1cbd
PM
116
117undef $db2;
118{
119 use warnings FATAL => 'untie';
120 eval { untie %h2 };
121 is $@, '', "untie without inner references" ;
122}
123
fc962064 124}