view release on metacpan or  search on metacpan

t/081_packed.t  view on Meta::CPAN

affix $lib, 'get_packed_u64_val',       [ Pointer [Void] ]        => UInt64;
affix $lib, 'make_packed_abc',          [ SInt32, SInt8, SInt32 ] => Packed( Struct [ a => SInt32, b => SInt8, c => SInt32 ] );
#
subtest 'C-level size and layout' => sub {
    is sizeof_packed_char_int(),   5, 'C sizeof(PackedCharInt) is 5 bytes';
    is sizeof_unpacked_char_int(), 8, 'C sizeof(UnpackedCharInt) is 8 bytes';
    is sizeof_packed_char_u64(),   9, 'C sizeof(PackedCharU64) is 9 bytes';
    is offset_packed_b(),          1, 'Packed field b offset is 1';
    is offset_unpacked_b(),        4, 'Unpacked field b offset is 4';
    ok sizeof_packed_char_int() < sizeof_unpacked_char_int(), 'Packed is smaller than unpacked';
    is sizeof_packed_char_int() + 3, sizeof_unpacked_char_int(), 'Difference is 3 bytes of padding';
};
#
subtest 'Perl sizeof matches C -- Packed(Struct[...])' => sub {
    is sizeof( Packed( Struct [ a => Char, b => Int ] ) ),    5, 'sizeof Packed(Char,Int) = 5';
    is sizeof( Packed( Struct [ a => Char, b => UInt64 ] ) ), 9, 'sizeof Packed(Char,UInt64) = 9';
    is sizeof( Struct [ a => Char, b => Int ] ), 8, 'sizeof Struct(Char,Int) = 8 (unpadded)';
};
#
subtest 'Perl sizeof matches C -- Packed[N, Struct[...]]' => sub {
    is sizeof( Packed [ 1, [ a => Char, b => Int ] ] ),    5, 'sizeof Packed[1,(Char,Int)] = 5';
    is sizeof( Packed [ 1, [ a => Char, b => UInt64 ] ] ), 9, 'sizeof Packed[1,(Char,UInt64)] = 9';
    is sizeof( Packed [ 4, [ a => Char, b => Int ] ] ),    8, 'sizeof Packed[4,(Char,Int)] = 8 (align 4)';
};
#
subtest 'Packed struct -- C fill and verify via C pointer' => sub {
    my $mem = calloc( 1, sizeof_packed_char_int() );
    ok $mem, 'calloc returned memory';
    fill_packed($mem);
    ok check_packed($mem), 'C verifies packed fields: a=65, b=12345';
};
#
subtest 'Unpacked Struct -- Perl field access' => sub {
    my $mem = calloc( 1, sizeof_unpacked_char_int() );
    fill_unpacked($mem);
    ok check_unpacked($mem), 'C verifies unpacked fields';
    my $p = cast( $mem, Struct [ a => Char, b => Int ] );
    is $p->{a}, 65,    'Read unpacked field a via magic';
    is $p->{b}, 12345, 'Read unpacked field b via magic';
};
#
subtest 'Packed struct -- Perl field access via magic' => sub {
    my $mem = calloc( 1, sizeof_packed_char_int() );
    fill_packed($mem);
    my $p = cast( $mem, Packed( Struct [ a => Char, b => Int ] ) );
    is $p->{a}, 65,    'Read packed field a via magic';
    is $p->{b}, 12345, 'Read packed field b via magic';
    $p->{a} = 90;
    $p->{b} = 54321;
    is $p->{a}, 90,    'Write and read packed field a';
    is $p->{b}, 54321, 'Write and read packed field b';
};
#
subtest 'Packed char + uint64_t -- C-level roundtrip' => sub {
    my $mem = calloc( 1, sizeof_packed_char_u64() );
    fill_packed_u64($mem);
    is get_packed_u64_char($mem), 88,                 'C reads packed char as 88 (ASCII "X")';
    is get_packed_u64_val($mem),  0xDEADBEEFCAFEBABE, 'C reads packed uint64_t correctly';
    my $p = cast( $mem, Packed( Struct [ a => Char, b => UInt64 ] ) );
    $p->{a} = 90;
    is get_packed_u64_char($mem), 90, 'C sees char updated via magic';
    $p->{b} = 0x1122334455667788;
    is get_packed_u64_val($mem), 0x1122334455667788, 'C sees u64 updated via magic';
};
#
subtest 'Packed struct -- by-value return' => sub {
    my $ret = make_packed_abc( 42, -66, 99 );
    is ref($ret), 'HASH', 'Return value is a hashref';
    is $ret->{a},  42,    'Field a returned correctly';
    is $ret->{b}, -66,    'Field b returned correctly';
    is $ret->{c},  99,    'Field c returned correctly';
};
#
done_testing;