This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/DBM_Filter/t/encode.t: Generalize for non-ASCII platforms
[perl5.git] / lib / DBM_Filter / t / utf8.t
CommitLineData
0e9b1cbd
PM
1
2use strict;
3use warnings;
4use Carp;
5
6BEGIN
7{
8
a7a22abc
KW
9 require "../t/charset_tools.pl";
10
0e9b1cbd
PM
11 eval { require Encode; };
12
13 if ($@) {
14 print "1..0 # Skip: Encode is not available\n";
15 exit 0;
16 }
17}
18
19require "dbm_filter_util.pl";
20
21use Test::More tests => 20;
22
23BEGIN { use_ok('DBM_Filter') };
e8ebc68a
JH
24my $db_file;
25BEGIN {
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};
0e9b1cbd
PM
35BEGIN { use_ok('Fcntl') };
36BEGIN { use_ok('charnames', qw{greek})};
37
38use charnames qw{greek};
39
40unlink <Op_dbmx*>;
41END { unlink <Op_dbmx*>; }
42
43my %h1 = () ;
e8ebc68a 44my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
0e9b1cbd 45
e8ebc68a 46ok $db1, "tied to $db_file";
0e9b1cbd
PM
47
48eval { $db1->Filter_Push('utf8') };
49is $@, '', "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
63VerifyData(\%h1,
64 {
65 'alpha' => "\N{alpha}",
66 "beta" => "\N{beta}",
67 "\N{gamma}"=> "gamma",
68 "" => "",
69 });
70
71undef $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
79my %h2 = () ;
e8ebc68a 80my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
0e9b1cbd 81
e8ebc68a 82ok $db2, "tied to $db_file";
0e9b1cbd 83
a7a22abc
KW
84VerifyData(\%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 });
0e9b1cbd
PM
91
92undef $db2;
93{
94 use warnings FATAL => 'untie';
95 eval { untie %h2 };
96 is $@, '', "untie without inner references" ;
97}
98