Affix

 view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN

    else if (elem_type->category == INFIX_TYPE_ARRAY) {
        // Return a new Affix::Pointer for this sub-array (Live view)
        Affix_Pin * new_pin;
        Newxz(new_pin, 1, Affix_Pin);
        new_pin->pointer = target;
        new_pin->managed = false;

        new_pin->owner_sv = pin->owner_sv ? pin->owner_sv : ST(0);
        SvREFCNT_inc(new_pin->owner_sv);

        // We need to keep the type info alive. For now, copy it.
        new_pin->type_arena = infix_arena_create(256);
        new_pin->type = _copy_type_graph_to_arena(new_pin->type_arena, elem_type);

        ST(0) = sv_2mortal(_new_pointer_obj(aTHX_ new_pin));
    }
    else {
        SV * res = sv_newmortal();
        ptr2sv(aTHX_ nullptr, target, res, elem_type);
        ST(0) = res;
    }

lib/Affix.h  view on Meta::CPAN

};
/// Represents an Affix::Pin object, a blessed Perl scalar that wraps a raw C pointer.
typedef struct {
    void * pointer;              ///< The raw C memory address.
    const infix_type * type;     ///< Infix's description of the data type at 'pointer'. Used for dereferencing.
    infix_arena_t * type_arena;  ///< Memory arena that owns the 'type' structure.
    bool managed;                ///< If true, Perl owns the 'pointer' and will safefree() it on DESTROY.
    UV ref_count;                ///< Refcount to prevent premature freeing when SVs are copied.
    size_t size;                 ///< Size of malloc'd void pointers.
    void (*destructor)(void *);  ///< Custom destructor function (e.g. SDL_DestroyWindow).
    SV * destructor_lib_sv;      ///< Perl object (Affix::Lib) to keep alive for the destructor.
    SV * owner_sv;               ///< Perl object that owns the memory, kept alive by this pin.
    size_t bit_offset;           ///< Bit offset (for bitfields)
    size_t bit_width;            ///< Bit width (for bitfields, 0 = not a bitfield)
} Affix_Pin;
/// Holds the necessary data for a callback, specifically the Perl subroutine to call.
typedef struct {
    SV * coderef_rv;  ///< A reference (RV) to the Perl coderef. We hold this to keep it alive.
    dTHXfield(perl)   ///< The thread context in which the callback was created.
} Affix_Callback_Data;
/// Internal struct holding the C resources that are magically attached
///        to a user's coderef (CV*) when it is first used as a callback.
typedef struct {
    infix_reverse_t * reverse_ctx;  ///< Handle to the infix reverse-call trampoline.
} Implicit_Callback_Magic;
/// An entry in the thread-local library registry hash.
typedef struct {
    infix_library_t * lib;  ///< The handle to the opened library.

t/007_pointers.t  view on Meta::CPAN

DLLEXPORT void libc_free(void * ptr){ free(ptr); }
END_C
#
my $lib_path = compile_ok($C_CODE);
ok( $lib_path && -e $lib_path, 'Compiled a test shared library successfully' );
#
affix $lib_path, 'read_int_from_void_ptr', [ Pointer [Void] ], Int;
my $mem = malloc(8);

# Cast returns a new pin. We must assign it or use the returned object.
# Also, we keep $mem alive to ensure the memory isn't freed if $int_ptr assumes
# $mem owns it (though cast usually creates unmanaged aliases, so we need $mem to stay alive).
my $int_ptr = Affix::cast( $mem, Pointer [Int] );

# Test magical 'set' via dereferencing
# $$int_ptr is a scalar magic that writes to the address
$$int_ptr = 42;

# Use the original $mem pointer for reading (verifying they point to the same place)
is( read_int_from_void_ptr($mem), 42, 'Magical set via deref wrote to C memory' );

# Test cast again

t/007_pointers.t  view on Meta::CPAN

    # Correct cleanup: Use the allocator that created it.
    c_free($string);
    pass('freed via c_free');
};
subtest 'deep pointers' => sub {

    # Deep Indirection (***int)
    isa_ok my $set_deep = wrap( $lib_path, 'set_int_deep', [ Pointer [ Pointer [ Pointer [Int] ] ], Int ] => Void ), ['Affix'];

    # Manually construct the pointer chain with correct types
    # Keep original 'malloc' pointers alive (managed) while using 'cast' aliases
    # Layer 1: The int value (int*)
    my $p_mem = malloc(8);
    my $p_val = Affix::cast( $p_mem, Pointer [Int] );

    # Assigning directly ($p_val = 0) would overwrite the magic scalar with a normal SV*
    $$p_val = 0;

    # Layer 2: Pointer to Layer 1 (int**)
    my $pp_mem = malloc(8);
    my $pp_val = Affix::cast( $pp_mem, Pointer [ Pointer [Int] ] );

t/019_fileio.t  view on Meta::CPAN

        # print {$retrieved_fh} "From Perl\n"; # Careful, might double-close if not careful
        # Check file content
        open my $check, '<', $filename;
        my @lines = <$check>;
        close $check;
        is scalar(@lines), 2, 'File has 2 lines';
        like $lines[0], qr/\[1\] First message/,  'Line 1 matches';
        like $lines[1], qr/\[2\] Second message/, 'Line 2 matches';
        free($logger);

        # Keep $fh alive until test end to avoid closing underneath C
        close $fh;
    };
    subtest 'File inside Struct (Value Return)' => sub {
        my ( $fh, $filename ) = tempfile();
        my $old_fh = select($fh);
        $| = 1;
        select($old_fh);

        # Call C function returning a struct by value
        my $logger_hash = create_logger($fh);