my
$header_bytes
=
"CROD\x00"
;
my
$DICTBYTE
=
$b10000000
;
my
$TEXTBYTE
=
$b00000000
;
my
$NULL
=
$b11101000
;
my
$SHORT
=
$b11001000
;
subtest
"empty dict"
,
sub
{
open
(
my
$fh
,
'<'
, \
"$header_bytes$DICTBYTE\x00"
);
isa_ok(
my
$dict
= Data::CompactReadonly->
read
(
$fh
),
"Data::CompactReadonly::V0::Dictionary::Byte"
);
is(
$dict
->count(), 0,
"0 element dict"
);
is(
$dict
->_ptr_size(), 1,
"1 byte pointers"
);
eq_or_diff(
$dict
->indices(), [],
"can list collection indices"
);
};
subtest
"1 element dict"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"\x00\x00"
.
"$header_bytes"
.
"$DICTBYTE\x01"
.
"\x09"
.
"\x0e"
.
"$TEXTBYTE\x03cow"
.
"$TEXTBYTE\x04calf"
));
read
(
$fh
,
my
$blah
, 2);
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
is(
$dict
->_db_base(), 2,
"the fh was opened after having already been partially read"
);
is(
$dict
->count(), 1,
"1 element dict"
);
eq_or_diff(
$dict
->indices(), [
'cow'
],
"can list collection indices"
);
is(
$dict
->element(
'cow'
),
'calf'
,
"can fetch from a 1 element dict"
);
};
subtest
"dict with Null key"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x01"
.
"\x09"
.
"\x0a"
.
"$NULL"
.
"$TEXTBYTE\x04calf"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
is(
$dict
->count(), 1,
"1 element dict"
);
throws_ok {
$dict
->indices() }
qr/Invalid type: Null: Dictionary keys must be Text/
,
"finding a bad key in the index is fatal"
;
throws_ok {
$dict
->element(
undef
) }
qr/Invalid element: \[undef\] isn't Text/
,
"asking for a Null key is fatal"
;
throws_ok {
$dict
->element(\
"cow"
) }
qr/Invalid element: SCALAR.* isn't Text/
,
"asking for a Reference key is fatal"
;
};
subtest
"dict with Collection key"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x01"
.
"\x09"
.
"\x0b"
.
"$DICTBYTE\x00"
.
"$TEXTBYTE\x04calf"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
throws_ok {
$dict
->indices() }
qr/Invalid type: .*Dictionary::Byte.*: Dictionary keys must be Text/
,
"finding a bad key in the index is fatal"
;
};
subtest
"missing data"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x01"
.
"\x09"
.
"\x0b"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
throws_ok {
$dict
->indices() }
qr/read.. tried to read/
,
"fatal read errors bomb out fast"
;
};
subtest
"2 element dict"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x02"
.
"\x0b"
.
"\x10"
.
"\x16"
.
"\x05"
.
"$TEXTBYTE\x03cow"
.
"$TEXTBYTE\x04calf"
.
"$TEXTBYTE\x04dict"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
is(
$dict
->count(), 2,
"2 element dict"
);
eq_or_diff(
$dict
->indices(), [
'cow'
,
'dict'
],
"can list collection indices"
);
is(
$dict
->element(
'cow'
),
'calf'
,
"can fetch element 0 from a 2 element dict"
);
isa_ok(
$dict
->element(
'dict'
),
'Data::CompactReadonly::V0::Dictionary'
,
"can fetch a Dictionary from element 1 of the Dictionary"
);
isa_ok(
$dict
->element(
'dict'
)->element(
'dict'
)->element(
'dict'
),
'Data::CompactReadonly::V0::Dictionary'
,
"it's Dictionaries all the way down"
);
is(
$dict
->id(),
$dict
->element(
'dict'
)->element(
'dict'
)->id(),
"circular references to dicts all have the same id"
);
};
subtest
"large odd number of elements in a dict"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x0b"
.
"\x1d"
.
"\x26"
.
"\x31"
.
"\x34"
.
"\x37"
.
"\x3a"
.
"\x3d"
.
"\x40"
.
"\x43"
.
"\x46"
.
"\x49"
.
"\x4c"
.
"\x4f"
.
"\x52"
.
"\x55"
.
"\x58"
.
"\x5b"
.
"\x5e"
.
"\x61"
.
"\x64"
.
"\x26"
.
"\x1d"
.
"$TEXTBYTE\x07Beijing"
.
"$TEXTBYTE\x09\xe5\x8c\x97\xe4\xba\xac\xe5\xb8\x82"
.
"$TEXTBYTE\x01a"
.
"$TEXTBYTE\x01A"
.
"$TEXTBYTE\x01b"
.
"$TEXTBYTE\x01B"
.
"$TEXTBYTE\x01c"
.
"$TEXTBYTE\x01C"
.
"$TEXTBYTE\x01d"
.
"$TEXTBYTE\x01D"
.
"$TEXTBYTE\x01e"
.
"$TEXTBYTE\x01E"
.
"$TEXTBYTE\x01f"
.
"$TEXTBYTE\x01F"
.
"$TEXTBYTE\x01g"
.
"$TEXTBYTE\x01G"
.
"$TEXTBYTE\x01h"
.
"$SHORT\x01\x02"
.
"$TEXTBYTE\x01i"
.
"$NULL"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
);
is(
$dict
->count(), 11,
"11 element dict"
);
eq_or_diff(
my
$indices
=
$dict
->indices(),
[
qw(Beijing a b c d e f g h i)
,
"\x{5317}\x{4eac}\x{5e02}"
],
"can list collection indices"
);
foreach
my
$index
(0 .. $
my
$wanted
= {
Beijing
=>
"\x{5317}\x{4eac}\x{5e02}"
,
"\x{5317}\x{4eac}\x{5e02}"
=>
'Beijing'
,
h
=> 0x0102,
i
=>
undef
,
map
{
$_
=>
uc
(
$_
) } (
'a'
..
'g'
)
}->{
$indices
->[
$index
]};
is(
$dict
->element(
$indices
->[
$index
]),
$wanted
,
"can fetch element $index from dictionary"
);
}
throws_ok {
$dict
->element(
'horse'
) }
qr/Invalid element: horse: doesn't exist/
,
"cry like a baby when trying to fetch non-existent elements"
;
is(
$dict
->
exists
(
'horse'
), 0,
"exists() works on a non-existent index"
);
is(
$dict
->
exists
(
'Beijing'
), 1,
"exists() works on an existent index"
);
throws_ok {
$dict
->
exists
(
undef
) }
qr/Invalid element: \[undef\] isn't Text/
,
"exists() dies when asked for something hopelessly invalid"
};
foreach
my
$use_cache
(0, 1) {
subtest
''
.(
$use_cache
?
'using'
:
'not using'
).
' fast collections cache'
=>
sub
{
subtest
"large even number of elements dict"
,
sub
{
open
(
my
$fh
,
'<'
, \(
"$header_bytes"
.
"$DICTBYTE\x06"
.
"\x13"
.
"\x16"
.
"\x19"
.
"\x1c"
.
"\x1f"
.
"\x22"
.
"\x25"
.
"\x28"
.
"\x2b"
.
"\x2e"
.
"\x31"
.
"\x34"
.
"$TEXTBYTE\x01a"
.
"$TEXTBYTE\x01A"
.
"$TEXTBYTE\x01b"
.
"$TEXTBYTE\x01B"
.
"$TEXTBYTE\x01c"
.
"$TEXTBYTE\x01C"
.
"$TEXTBYTE\x01d"
.
"$TEXTBYTE\x01D"
.
"$TEXTBYTE\x01e"
.
"$TEXTBYTE\x01E"
.
"$TEXTBYTE\x01f"
.
"$TEXTBYTE\x01F"
));
my
$dict
= Data::CompactReadonly->
read
(
$fh
,
fast_collections
=>
$use_cache
);
if
(
$use_cache
) {
eq_or_diff(
$dict
->{cache},
{},
"start with empty cache"
);
}
is(
$dict
->count(), 6,
"6 element dict"
);
if
(
$use_cache
) {
eq_or_diff(
$dict
->{cache},
{
count
=> 6 },
"count cached"
);
}
is(
$dict
->element(
'a'
),
'A'
,
'can fetch element 0 from dictionary'
);
if
(
$use_cache
) {
eq_or_diff(
$dict
->{cache},
{
count
=> 6,
keys
=> {
0
=>
'a'
,
1
=>
'b'
,
2
=>
'c'
},
values
=> {
0
=>
'A'
},
},
"cache partially populated"
);
}
is(
$dict
->element(
'b'
),
'B'
,
'can fetch element 1 from dictionary'
);
is(
$dict
->element(
'c'
),
'C'
,
'can fetch element 2 from dictionary'
);
is(
$dict
->element(
'd'
),
'D'
,
'can fetch element 3 from dictionary'
);
is(
$dict
->element(
'e'
),
'E'
,
'can fetch element 4 from dictionary'
);
is(
$dict
->element(
'f'
),
'F'
,
'can fetch element 5 from dictionary'
);
if
(
$use_cache
) {
eq_or_diff(
$dict
->{cache},
{
count
=> 6,
keys
=> {
0
=>
'a'
,
1
=>
'b'
,
2
=>
'c'
,
3
=>
'd'
,
4
=>
'e'
,
5
=>
'f'
},
values
=> {
0
=>
'A'
,
1
=>
'B'
,
2
=>
'C'
,
3
=>
'D'
,
4
=>
'E'
,
5
=>
'F'
},
},
"cache fully populated"
);
close
(
$fh
);
is(
$dict
->element(
'f'
),
'F'
,
'and yep, we definitely use the cache'
);
}
};
};
}
done_testing;