view release on metacpan or  search on metacpan

t/001_affix.t  view on Meta::CPAN

        b    => UInt32, 16,    # b : uint32 : 16
        c    => UInt32, 16,    # c : uint32 : 16
        d    => UInt32, 16,    # d : uint32 : 16
        tail => UInt8          # tail : uint8
    ];
    isa_ok my $check = wrap( $lib_path, 'check_trailing', [$trailing] => UInt8 ), ['Affix'];
    is $check->( { a => 1, b => 2, c => 3, d => 4, tail => 0x5A } ), 0x5A, 'd (bit offset 16) marshals without disturbing the following member';
    is $check->( { a => 0xFFFF, b => 0xFFFF, c => 0xFFFF, d => 0xFFFF, tail => 0x5A } ), 0x5A,
        'max-value d (bit offset 16) marshals without disturbing the following member';
};
subtest 'Forward Call with Many Arguments' => sub {
    note 'Testing a C function with more arguments than available registers.';
    my $sig = '(int64, int64, int64, int64, int64, int64, int64, int64, int64)->int64';
    isa_ok my $summer = wrap( $lib_path, 'multi_arg_sum', $sig ), ['Affix'];
    my $result = $summer->( 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000 );
    is $result, 111111111, 'Correctly passed 9 arguments to a C function';
};
subtest 'Parser Error Reporting' => sub {
    note 'Testing that malformed signatures produce helpful error messages.';
    like warning { Affix::wrap( $lib_path, 'add', '(int, ^, int)->int' ) }, qr[parse signature], 'wrap() warning on invalid signature';
    like warning { Affix::sizeof('{int, double') },                         qr[parse signature], 'sizeof() warning on unterminated aggregate';
};
subtest 'These are called under valgrind in 900_leak' => sub {
    subtest 'use Affix' => sub {
        use Affix qw[];
        pass 'loaded';
    };
    subtest 'affix($$$$)' => sub {
        no warnings 'redefine';
        ok affix( libm, 'pow', [ Double, Double ], Double ), 'affix pow( Double, Double )';
        is pow( 5, 2 ), 25, 'pow(5, 2)';
    };
    subtest 'wrap($$$$)' => sub {
        isa_ok my $pow = wrap( libm, 'pow', [ Double, Double ], Double ), ['Affix'], 'double pow(double, double)';
        is $pow->( 5, 2 ), 25, '$pow->(5, 2)';
    };
    subtest 'return pointer' => sub {
        my $lib = compile_ok(<<'');
#include "std.h"
// ext: .c
void * test( ) { void * ret = "Testing"; return ret; }

        ok my $fn         = wrap( $lib, 'test', [] => Pointer [Void] ), 'affix';
        ok my $string_ptr = $fn->(),                                    'call';

        # Casting a pointer to String should return the Value "Testing"
        is Affix::cast( $string_ptr, String ), 'Testing', 'cast($ptr, String) returns value';
    }
};
subtest 'affix/wrap function pointer' => sub {
    my $lib = compile_ok(<<~'');
    #include "std.h"
    //ext: .c
    DLLEXPORT int add(int a, int b) { return a + b; }


    # Get address via find_symbol (simulating getting it from vtable or dlsym)
    my $ptr = find_symbol( load_library($lib), 'add' );
    ok $ptr, 'Got function pointer';

    # Test wrap(undef, $ptr, ...)
    subtest 'wrap(undef, $ptr, ...)' => sub {
        my $fn = wrap( undef, $ptr, [ Int, Int ] => Int );
        is $fn->( 10, 20 ), 30, 'Wrapped raw function pointer works';
    };

    # Test affix(undef, [$ptr => 'name'], ...)
    subtest 'affix(undef, [$ptr => name], ...)' => sub {
        affix( undef, [ $ptr => 'my_add' ], [ Int, Int ] => Int );
        is my_add( 5, 5 ), 10, 'Affixed raw function pointer works';
    };

    # Test wrap with explicit raw integer (simulating cast)
    subtest 'wrap(undef, int_addr, ...)' => sub {
        my $addr = address($ptr);                               # Convert Pin to UV
        my $fn   = wrap( undef, $addr, [ Int, Int ] => Int );
        is $fn->( 3, 4 ), 7, 'Wrapped raw integer address works';
    };
};
#
done_testing;