no
warnings
qw(portable)
;
my
$header_bytes
=
"CROD\x00"
;
open
(
my
$fh
,
'<'
, \
"$header_bytes${b01000000}\x00"
);
isa_ok(
my
$array
= Data::CompactReadonly->
read
(
$fh
),
"Data::CompactReadonly::V0::Array::Byte"
);
is(
$array
->count(), 0,
"empty array"
);
is(
$array
->_ptr_size(), 1,
"1 byte pointers"
);
eq_or_diff(
$array
->indices(), [],
"can list collection indices"
);
throws_ok {
$array
->element(-1) }
qr/Invalid element: -1: negative/
,
"negative elements are illegal"
;
throws_ok {
$array
->element(3.7) }
qr/Invalid element: 3.7: non-integer/
,
"non-integer elements are illegal"
;
throws_ok {
$array
->element(
'horse'
) }
qr/Invalid element: horse: non-integer/
,
"non-numeric elements are illegal"
;
throws_ok {
$array
->element(0) }
qr/Invalid element: 0: out of range/
,
"trying to read beyond end of empty array is fatal"
;
my
$ARRAYBYTE
=
$b01000000
;
my
$ARRAYSHORT
=
$b01001000
;
my
$ARRAYMEDIUM
=
$b01010000
;
my
$ARRAYLONG
=
$b01011000
;
my
$TEXTBYTE
=
$b00000000
;
my
$DICTBYTE
=
$b10000000
;
my
$BYTE
=
$b11000000
;
my
$SHORT
=
$b11001000
;
my
$MEDIUM
=
$b11010000
;
my
$LONG
=
$b11011000
;
my
$HUGE
=
$b11100000
;
my
$NULL
=
$b11101000
;
open
(
$fh
,
'<'
, \(
"\x00\x00"
.
"$header_bytes"
.
"$ARRAYBYTE\x02\x0c\x09"
.
"$SHORT\x94\x45"
.
"$BYTE\x94"
));
read
(
$fh
,
my
$blah
, 2);
$array
= Data::CompactReadonly->
read
(
$fh
);
is(
$array
->_db_base(), 2,
"the fh was opened after having already been partially read"
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Byte'
);
is(
$array
->count(), 2,
"2 element array"
);
throws_ok {
$array
->element(94) }
qr/Invalid element: 94: out of range/
,
"trying to read beyond end of non-empty array is fatal"
;
is(
$array
->element(0), 0x94,
"fetched a Byte element from the array"
);
is(
$array
->element(1), 0x9445,
"fetched a Short element from the array"
);
open
(
$fh
,
'<'
, \(
"$header_bytes"
.
"$ARRAYSHORT\x00\x02\x0d\x0a"
.
"$SHORT\x94\x45"
.
"$MEDIUM\x12\x34\x56"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Short'
);
is(
$array
->count(), 2,
"2 element array"
);
is(
$array
->element(0), 0x123456,
"fetched a Medium element from the array"
);
is(
$array
->element(1), 0x9445,
"fetched a Short element from the array"
);
open
(
$fh
,
'<'
, \(
"$header_bytes"
.
"$ARRAYSHORT\x00\x03\x10\x0b\x19"
.
"$LONG\xab\xcd\xef\x01"
.
"$HUGE\xfe\xdc\xba\x98\x76\x54\x32\x10"
.
"$NULL"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Short'
);
is(
$array
->count(), 3,
"3 element array"
);
is(
$array
->element(0), 0xfedcba9876543210,
"fetched a Huge element from the array"
);
is(
$array
->element(1), 0xabcdef01,
"fetched a Long element from the array"
);
is(
$array
->element(2),
undef
,
"fetched a Null element from the array"
);
eq_or_diff(
$array
->indices(), [0, 1, 2],
"can list collection indices"
);
open
(
$fh
,
'<'
, \(
"CROD${b00000001}"
.
"$ARRAYSHORT\x00\x06"
.
"\x00\x19"
.
"\x00\x14"
.
"\x00\x22"
.
"\x00\x23"
.
"\x00\x05"
.
"\x00\x2e"
.
"$LONG\xab\xcd\xef\x01"
.
"$HUGE\xfe\xdc\xba\x98\x76\x54\x32\x10"
.
"$NULL"
.
"$TEXTBYTE\x09Fran\xc3\xa7ais"
.
"$DICTBYTE\x00"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Short'
);
is(
$array
->_ptr_size(), 2,
"2 byte pointers"
);
is(
$array
->count(), 6,
"6 element array"
);
is(
$array
->element(0), 0xfedcba9876543210,
"fetched a Huge element from the array"
);
is(
$array
->element(1), 0xabcdef01,
"fetched a Long element from the array"
);
is(
$array
->element(2),
undef
,
"fetched a Null element from the array"
);
is(
$array
->element(3),
"Fran\xe7ais"
,
"fetched a Text element from the array"
);
isa_ok(
my
$array2
=
$array
->element(4),
'Data::CompactReadonly::V0::Array::Short'
,
"fetched an Array element from the array"
);
isa_ok(
$array
->element(5),
'Data::CompactReadonly::V0::Dictionary::Byte'
,
"fetched a Dictionary element from the array"
);
is(
$array2
->_ptr_size(), 2,
"2 byte pointers"
);
is(
$array2
->count(), 6,
"6 element array"
);
is(
$array2
->element(0), 0xfedcba9876543210,
"fetched a Huge element from the array"
);
is(
$array2
->element(1), 0xabcdef01,
"fetched a Long element from the array"
);
is(
$array2
->element(2),
undef
,
"fetched a Null element from the array"
);
is(
$array2
->element(3),
"Fran\xe7ais"
,
"fetched a Text element from the array"
);
isa_ok(
$array2
->element(4),
'Data::CompactReadonly::V0::Array::Short'
,
"fetched an Array element from the embedded array"
);
isa_ok(
$array
->element(4)->element(4)->element(4)->element(4)->element(4),
'Data::CompactReadonly::V0::Array::Short'
,
"it's arrays all the way down"
);
is(
$array
->id(),
$array
->element(4)->element(4)->id(),
"circular references to arrays all have the same id"
);
is(
$array
->
exists
(6), 0,
"exists() works on a non-existent element"
);
is(
$array
->
exists
(2), 1,
"exists() works on an existent element"
);
throws_ok {
$array
->
exists
(-1) }
qr/negative/
,
"exists() dies as expected on an illegal (negative) index"
;
throws_ok {
$array
->
exists
(
'horse'
) }
qr/non-integer/
,
"exists() dies as expected on an illegal (non-integer) index"
;
open
(
$fh
,
'<'
, \(
"CROD${b00000010}"
.
"$ARRAYLONG\x00\x00\x00\x01"
.
"\x00\x00\x0d"
.
"$BYTE\x09"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Long'
);
is(
$array
->count(), 1,
"1 element array"
);
is(
$array
->_ptr_size(), 3,
"3 byte pointers"
);
is(
$array
->element(0), 9,
"can fetch"
);
open
(
$fh
,
'<'
, \(
"CROD${b00000011}"
.
"$ARRAYLONG\x00\x00\x00\x01"
.
"\x00\x00\x00\x0e"
.
"$BYTE\x09"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Long'
);
is(
$array
->count(), 1,
"1 element array"
);
is(
$array
->_ptr_size(), 4,
"4 byte pointers"
);
is(
$array
->element(0), 9,
"can fetch"
);
open
(
$fh
,
'<'
, \(
"CROD${b00000111}"
.
"$ARRAYMEDIUM\x00\x00\x01"
.
"\x00\x00\x00\x00\x00\x00\x00\x11"
.
"$BYTE\x09"
));
$array
= Data::CompactReadonly->
read
(
$fh
);
isa_ok(
$array
,
'Data::CompactReadonly::V0::Array::Medium'
);
is(
$array
->count(), 1,
"1 element array"
);
is(
$array
->_ptr_size(), 8,
"8 byte pointers"
);
is(
$array
->element(0), 9,
"can fetch"
);
done_testing;