This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Spelling nit by Jim Cromie
[perl5.git] / lib / DBM_Filter / t / encode.t
CommitLineData
0e9b1cbd
PM
1
2use strict;
3use warnings;
4use Carp;
5
6
7BEGIN
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
19require "dbm_filter_util.pl";
20
21use Test::More tests => 26;
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('encode' => 'blah') };
c3a085ec 49like $@, qr/^Encoding 'blah' is not available/, "push an illegal filter" ;
0e9b1cbd
PM
50
51eval { $db1->Filter_Push('encode') };
52is $@, '', "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
67VerifyData(\%h1,
68 {
69 'alpha' => "\N{alpha}",
70 "beta" => "\N{beta}",
71 "\N{gamma}"=> "gamma",
72 "" => "",
73 });
74
75eval { $db1->Filter_Pop() };
76is $@, '', "pop the 'utf8' filter" ;
77
78eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
79is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
80
81use charnames qw{:full};
82StoreData(\%h1,
83 {
84 'euro' => "\N{EURO SIGN}",
85 });
86
87undef $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
95my %h2 = () ;
e8ebc68a 96my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
0e9b1cbd 97
e8ebc68a 98ok $db2, "tied to $db_file";
0e9b1cbd 99
2f3efc97
JH
100if (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}
0e9b1cbd
PM
119
120undef $db2;
121{
122 use warnings FATAL => 'untie';
123 eval { untie %h2 };
124 is $@, '', "untie without inner references" ;
125}
126