view release on metacpan or  search on metacpan

t/999_marshaller_2.t  view on Meta::CPAN

        # Set with int
        $task->{status} = 2;
        is "$task->{status}", 'SUCCESS', 'Enum set by integer matches string SUCCESS';

        # Make sure it's a dualvar
        ok( $task->{status} == 2 && $task->{status} eq 'SUCCESS', 'Enum is a proper Dualvar' );
    };
    subtest auto => sub {
        my $mem  = alloc_owned( sizeof( AutoTask() ) );
        my $task = cast( $mem, AutoTask() );

        # Write to Enum by String Name
        $task->{status} = 'RUNNING';

        # Internal representation validation (No off-by-one)
        is int $task->{status}, 1, 'Enum written by name resolves to exact integer 1';

        # Dualvar retrieval check (SVt_PVIV upgrade successful in C)
        is "$task->{status}", 'RUNNING', 'Enum read back retains string mapping (Dualvar SV Upgrade successful)';

        # VTable Shadowing verification (C interception is correctly scoped to vtbl_enum)
        $task->{status} = 2;
        is "$task->{status}", 'SUCCESS', 'Enum written by integer successfully stringifies to mapped name';
        ok( $task->{status} == 2 && $task->{status} eq 'SUCCESS', 'Dualvar operations work symmetrically in Perl' );

        # Auto-enumerated Enums verification
        $task->{auto} = 'PROCESSED';
        is int( $task->{auto} ), 1, 'Implicit enum correctly evaluated next index as integer 1';

        # VTable scoping / memory boundaries
        is is_pin($task), T(), 'Task pointer is natively tracked as a v2 FFI Pin';
    }
};
subtest 'Feature: Signed Bitfields' => sub {

    # 4-bit signed bitfield (range: -8 to 7)
    typedef Bits => Struct [ low => SInt8 | 4, high => SInt8 | 4 ];
    my $mem = alloc_owned( sizeof( Bits() ) );
    my $b   = cast( $mem, Bits() );
    $b->{low} = 3;
    is $b->{low}, 3, 'Positive bitfield value is correct';

    # Assign -3 to the 4-bit signed field
    $b->{high} = -3;

    # Due to sign extension, -3 (1101 in 4-bit two's complement) should read back as -3
    is $b->{high}, -3, 'Negative signed bitfield is correctly sign-extended on read';
    $b->{low} = -8;
    is $b->{low}, -8, 'Min bounds of 4-bit signed field is -8';
};
subtest 'Feature: Pointer-to-Pointer / StringList (char**)' => sub {
    typedef Cmd => Struct [ argc => Int, argv => Pointer [ Pointer [Char] ] ];
    my $mem = alloc_owned( sizeof( Cmd() ) );
    my $cmd = cast( $mem, Cmd() );

    # Native assignment of an ArrayRef to a char** field
    $cmd->{argv} = [ "hello", "world", "ffi" ];
    $cmd->{argc} = 3;

    # FFI-intercept read: Pointer to Pointer converts seamlessly back to ArrayRef
    my $read_back = $cmd->{argv};
    is ref($read_back),     'ARRAY', 'StringList reads back as a native Perl ArrayRef';
    is scalar(@$read_back), 3,       'ArrayRef has correct element count';
    is $read_back->[0],     'hello', 'Element 0 matches';
    is $read_back->[1],     'world', 'Element 1 matches';
    is $read_back->[2],     'ffi',   'Element 2 matches';
};
subtest 'Feature: Const-Correctness / Readonly Pins' => sub {
    typedef Info => Struct [ version => Float, author => String ];
    my $mem  = alloc_owned( sizeof( Info() ) );
    my $info = cast( $mem, Info() );
    $info->{version} = 1.0;

    # Apply readonly state
    ok !Affix::readonly($info), 'Pin defaults to mutable';
    Affix::readonly( $info, 1 );
    ok Affix::readonly($info), 'Pin is now marked readonly';

    # Attempting to assign should croak
    like dies {
        $info->{version} = 2.0;
    }, qr/Modification of a read-only C value attempted/, 'Caught illegal write to readonly pin';
    is $info->{version}, 1.0, 'Value remained unmodified after exception';

    # Unlock
    Affix::readonly( $info, 0 );
    $info->{version} = 2.0;
    is $info->{version}, 2.0, 'Value successfully modified after unlocking';
};
subtest 'Feature: SIMD Vectors' => sub {

    # 4-element single-precision float vector
    typedef SimdType => Vector [ 4, Float32 ];
    my $mem = alloc_owned( sizeof( SimdType() ) );
    my $vec = cast( $mem, SimdType() );

    # Vectors map to arrayrefs natively during bind
    $vec->[0] = 1.1;
    $vec->[1] = 2.2;
    $vec->[2] = 3.3;
    $vec->[3] = 4.4;
    is int( $vec->[0] ), 1, 'SIMD element 0 read OK';
    is int( $vec->[3] ), 4, 'SIMD element 3 read OK';
};
subtest varargs => sub {
    affix libc, [ 'sprintf' => 'my_sprintf' ], [ Pointer [SChar], Pointer [SChar], VarArgs ], Int;
    typedef Vec => Struct [ x => Int, y => Int ];
    my $mem = alloc_owned( sizeof( Vec() ) );
    my $v   = cast( $mem, Vec() );
    $v->{x} = 100;
    $v->{y} = 200;

    # Test 1: Pass v2 members to variadic
    my $out = " " x 100;

    # sprintf(buf, "%d %d", v->x, v->y)
    # Affix must extract the integers from the magical scalars
    my_sprintf( $out, "%d and %d", $v->{x}, $v->{y} );
    like $out, qr/100 and 200/, 'Variadic correctly marshalled V2 magical members';