Affix
view release on metacpan or search on metacpan
- WChar now maps to the platform-correct `wchar_t` type (uint16 on Windows, uint32 elsewhere) instead of hardcoded `uint16`.
- WString now platform-dependent (`*uint16` on Windows, `*uint32` elsewhere).
- StringList redefined as `Pointer[Pointer[Char]]` instead of the `@StringList` alias.
- Extended `_is_signature_string` to recognize `+`, `c[...]`, `v[...]`, and `e:` prefixed type strings.
- Do not rewind `args_arena` so pointers survive XSUB return (hopefully callee stored them).
### Fixed
- Fixed struct member callback assignment where `$pin->{fn} = sub { ... }` silently created a trampoline with 0 arguments, causing "Too few arguments" errors or crashes when C called through the function pointer. `Pointer[Callback[...]]` creates a do...
- `set_ptr` now croaks when a coderef is assigned to a non-callback pointer type instead of silently creating a broken 0-argument trampoline.
- Fixed fuzzer `struct_callback` variant's verify function to truncate expected values to the callback return type's width.
- Fixed packed struct layout where `Packed(Struct[...])` returned sizeof values matching unpacked structs.
- Replaced silent fallbacks with proper errors: unknown primitive type IDs in opcode dispatch and enum size handling now croak instead of silently misinterpreting memory.
- Added warning when callback type signature serialization fails instead of silently returning a raw pointer value.
- Fixed a sign-extension bug in 128-bit integer parsing.
- Fixed bitfield write-back logic to use proper bitmasking, preventing neighboring bit corruption.
- Corrected `wstring` (UTF-16/32) conversion to handle null-terminators properly in fixed-size arrays.
- Fixed `Affix::Wrap` eval-generated bindings on macOS where Clang emits Mach-O underscore-prefixed `mangledName` (`_return_six`), but `dlsym` expects the source-level name (`return_six`).
- [infix] Fixed RAX register preservation in Windows x64 reverse trampoline epilogue for void functions, preventing clobber of the return value register.
- [infix] Fixed SysV x64 reverse trampoline handling of `ARG_LOCATION_GPR_REFERENCE` for aggregates >16 bytes passed by reference.
- [infix] Corrected handling of aggregates classified as `MEMORY` during reverse trampoline calls in SysV.
- SIMD Vector Improvements:
- Added M512, M512d, and M512i type helpers.
- Ensured compatibility with infix's refined vector alignment and passing rules.
- [infix] Added support for half-precision floating-point (`float16`).
- [infix] Implemented C++ exception propagation through JIT frames on Linux (x86-64 and ARM64) using manual DWARF `.eh_frame` generation and `__register_frame`.
- [infix] Implemented Structured Exception Handling (SEH) for Windows x64 and ARM64 for C++ exception propagation through trampolines.
- [infix] Added `infix_forward_create_safe` API to establish an exception boundary that catches native exceptions and returns a dedicated error code (`INFIX_CODE_NATIVE_EXCEPTION`).
- [infix] Added support for 256-bit (AVX) and 512-bit (AVX-512) vectors in the System V ABI.
- [infix] Added support for receiving bitfield structs in reverse call trampolines.
- [infix] Added trampoline caching. Identical signatures and targets now share the same JIT-compiled code and metadata via internal reference counting, significantly reducing memory overhead and initialization time.
- [infix] Added a new opt-in build mode (`--sanity`) that emits extra JIT instructions to verify stack pointer consistency around user-provided marshaller calls, making it easier to debug corrupting language bindings.
### Changed
- Pull infix v0.1.6.
- [infix] Explicitly enabled 16-byte stack alignment in Windows x64 trampolines to ensure SIMD compatibility.
- [infix] Updated `infix_type_create_vector` to use the vector's full size for its natural alignment (e.g., 32-byte alignment for `__m256`).
- [infix] Refined the Windows x64 ABI to pass all vector types by reference (pointer in GPR). This ensures compatibility with MSVC which expects even 128-bit vectors to be passed via pointer in many scenarios, while still returning them by value in `...
- [infix] Move to a pre-calculated hash field in `_infix_registry_entry_t`. Lookups and rehashing now use this stored hash, significantly reducing string hashing overhead during type resolution and registry scaling.
- [infix] Optimized Type Registry memory management: Internal hash table buckets are now heap-allocated and freed during rehashes, preventing memory "leaks" within the registry's arena.
```
**Note:** You must call `errno()` immediately after the C function invokes, as subsequent Perl operations (like
printing to STDOUT) might overwrite the system's error register.
## Memory Inspection
### `dump( $pin, $length_in_bytes )`
Prints a formatted hex dump of the memory pointed to by a Pin directly to `STDOUT`. This is an invaluable tool for
verifying that C structs or buffers contain the data you expect.
```perl
my $ptr = strdup("Affix Debugging");
dump($ptr, 16);
# Output:
# Dumping 16 bytes from 0x55E9A8A5 at script.pl line 42
# 000 41 66 66 69 78 20 44 65 62 75 67 67 69 6e 67 00 | Affix Debugging.
```
builder/Affix/Builder.pm view on Meta::CPAN
@targets = qw[wrap grammar register cross];
}
# Perl fuzz target metadata
my %perl_targets = (
wrap => { script => 'fuzz_wrap_type_sig.pl', desc => 'Affix::Wrap::Type->parse()', needs_lib => 1 },
grammar => { script => 'fuzz_grammar_mutate.pl', desc => 'Grammar-aware C sig mutations', needs_lib => 1, extra_inc => 1 },
register => { script => 'fuzz_register_types.pl', desc => 'Affix::_typedef() — C parser direct', needs_lib => 1 },
cross => { script => 'fuzz_cross_boundary.pl', desc => 'Cross-boundary Perl->C->JIT', needs_lib => 1 },
compile => { script => 'fuzz_compile_ok.pl', desc => 'compile_ok() C compilation', needs_lib => 1 },
shared => { script => 'fuzz_shared_lib.pl', desc => 'Compile→load→affix→call→verify ABI', needs_lib => 1 },
);
# C fuzz targets (delegate to infix/build.pl)
my %c_targets = (
signature => 'Parser crashes + arena stress',
abi => 'ABI classification',
types => 'Type generator bugs',
roundtrip => 'Type->String->Type consistency',
trampoline => 'JIT trampoline creation',
direct => 'Direct marshalling JIT',
infix/include/infix/infix.h view on Meta::CPAN
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#ifdef __cplusplus
extern "C" {
#endif
/**
* @brief Retrieves the version of the infix library linked at runtime.
*
* @details This function allows applications to verify that the version of the
* library they are linked against matches the headers they were compiled with.
* This is particularly useful when loading `infix` as a shared library/DLL
* to detect version mismatches.
*
* @return An `infix_version_t` structure containing the major, minor, and patch numbers.
*/
INFIX_API INFIX_NODISCARD infix_version_t infix_get_version(void);
/**
* @defgroup high_level_api High-Level Signature API
infix/src/arch/aarch64/abi_arm64_common.h view on Meta::CPAN
*
* 1. **Register Enumerations:** It defines enums for the general-purpose registers (GPRs) and
* the floating-point/SIMD registers (VPRs). These enums provide a clear, type-safe,
* and self-documenting way to refer to specific registers when emitting machine
* code or implementing the ABI logic. The comments on each register describe its
* role according to the standard AAPCS64 calling convention.
*
* 2. **Instruction Encoding Constants:** It contains preprocessor definitions for the
* fixed bitfields of various AArch64 instructions. This abstracts away the
* "magic numbers" of machine code generation, making the emitter code in
* `abi_arm64_emitters.c` more readable and easier to verify against the official
* ARM Architecture Reference Manual.
*
* By centralizing these definitions, this header provides a single source of truth for
* the low-level architectural details, separating them from the higher-level ABI logic.
* @endinternal
*/
#include <stdint.h>
/**
* @internal
* @enum arm64_gpr
infix/src/arch/aarch64/abi_arm64_common.h view on Meta::CPAN
A64_COND_LE = 0xD, ///< Less Than or Equal (Signed)
A64_COND_AL = 0xE, ///< Always
} arm64_cond;
/**
* @internal
* @defgroup aarch64_opcodes AArch64 Instruction Opcodes and Bitfields
* @brief Defines for the bit-level encoding of AArch64 instructions.
* @details These constants represent the fixed bit patterns for various instruction
* classes as specified in the ARM Architecture Reference Manual. Using these
* defines instead of raw hex literals makes the emitter code more readable
* and easier to verify. The `U` suffix is critical to prevent signed
* integer overflow during bit-shifting operations at compile time.
* @{
*/
// Common bitfields
#define A64_SF_64BIT (1U << 31) // 'sf' (size field) bit for 64-bit operations
#define A64_SF_32BIT (0U << 31) // 'sf' bit for 32-bit operations
#define A64_V_VECTOR (1U << 26) // Vector bit for SIMD/FP instructions
// Data Processing -- Immediate (e.g., ADD, SUB)
#define A64_OPC_ADD (0b00U << 29)
#define A64_OPC_ADDS (0b01U << 29)
infix/src/arch/riscv/abi_riscv64_common.h view on Meta::CPAN
*
* 1. **Register Enumerations:** It defines enums for the general-purpose registers (GPRs) and
* the floating-point registers (FPRs). These enums provide a clear, type-safe,
* and self-documenting way to refer to specific registers when emitting machine
* code or implementing the ABI logic. The comments on each register describe its
* role according to the standard RISC-V ELF psABI calling convention (lp64d).
*
* 2. **Instruction Encoding Constants:** It contains preprocessor definitions for the
* fixed bitfields of various RISC-V instructions. This abstracts away the
* "magic numbers" of machine code generation, making the emitter code in
* `abi_riscv64_emitters.c` more readable and easier to verify against the
* RISC-V specification (Volume I: Unprivileged ISA).
* @endinternal
*/
#include <stdint.h>
/**
* @internal
* @enum riscv_gpr
* @brief Enumerates the RISC-V 64-bit General-Purpose Registers (x0-x31).
*
* @details The enum values (0-31) correspond directly to the 5-bit register numbers
infix/src/arch/riscv/abi_riscv64_common.h view on Meta::CPAN
F_FT10_REG, ///< f30: Temporary / caller-saved.
F_FT11_REG ///< f31: Temporary / caller-saved.
} riscv_fpr;
/**
* @internal
* @defgroup riscv64_opcodes RISC-V Instruction Opcodes and Bitfields
* @brief Defines for the bit-level encoding of RISC-V instructions.
* @details These constants represent the fixed bit patterns for various instruction
* classes as specified in "The RISC-V Instruction Set Manual, Volume I".
* Using these defines instead of raw hex literals makes the emitter code
* more readable and easier to verify. The `U` suffix is critical to prevent
* signed integer overflow during bit-shifting operations at compile time.
* @{
*/
// Base opcodes (bits 6:0)
#define RV_OP_LOAD 0x03U // Loads (lb, lh, lw, ld, lbu, lhu, lwu)
#define RV_OP_OP_IMM 0x13U // Register-immediate ALU ops (addi, slli, ...)
#define RV_OP_OP_IMM_32 0x1BU // Register-immediate 32-bit ALU ops (addiw)
#define RV_OP_AUIPC 0x17U // Add upper immediate to pc
#define RV_OP_STORE 0x23U // Stores (sb, sh, sw, sd)
#define RV_OP_OP 0x33U // Register-register ALU ops (add, sub, sll, ...)
infix/src/common/infix_config.h view on Meta::CPAN
* from a source (like the parser's temporary arena) into its own private arena.
* The size of the source arena is used as a hint for the new arena's size, but the
* copy process itself requires a small amount of extra memory for its own bookkeeping
* (e.g., the memoization list in `_copy_type_graph_to_arena_recursive`). This
* headroom provides that extra space to prevent allocation failures during the copy.
*/
#define INFIX_TRAMPOLINE_HEADROOM 128
/**
* @def INFIX_SANITY_CHECK_ENABLE
* @brief If defined and non-zero, the JIT will emit extra instructions to verify
* stack consistency around user-provided marshaller calls.
*/
#ifndef INFIX_SANITY_CHECK_ENABLE
#define INFIX_SANITY_CHECK_ENABLE 0
#endif
/**
* @def INFIX_INTERNAL
* @brief When compiling with -fvisibility=hidden, we use this to explicitly mark internal-but-shared functions as
* hidden.
infix/src/core/signature.c view on Meta::CPAN
* @details This module is responsible for two key functionalities that form the
* user-facing API of the library:
*
* 1. **Parsing:** It contains a hand-written recursive descent parser that transforms a
* human-readable signature string (e.g., `"({int, *char}) -> void"`) into an
* unresolved `infix_type` object graph. This is the **"Parse"** stage of the core
* data pipeline. The internal entry point for the "Parse" stage is `_infix_parse_type_internal`.
*
* 2. **Printing:** It provides functions to serialize a fully resolved `infix_type`
* graph back into a canonical signature string. This is crucial for introspection,
* debugging, and verifying the library's understanding of a type.
*
* The public functions `infix_type_from_signature` and `infix_signature_parse`
* are high-level orchestrators. They manage the entire **"Parse -> Copy -> Resolve -> Layout"**
* pipeline, providing the user with a fully validated, self-contained, and ready-to-use
* type object that is safe to use for the lifetime of its returned arena.
*/
#include "common/infix_internals.h"
#include <ctype.h>
#include <stdarg.h>
#include <stdbool.h>
lib/Affix.c view on Meta::CPAN
(void)newXSproto_portable("main::wrap_owned", XS_main_wrap_owned, __FILE__, "$$");
(void)newXSproto_portable("main::alloc_owned", XS_main_alloc_owned, __FILE__, "$");
(void)newXSproto_portable("main::free_owned", XS_main_free_owned, __FILE__, "$");
(void)newXSproto_portable("Affix::Memory::DESTROY", XS_main_free_owned, __FILE__, "$");
(void)newXSproto_portable("main::alloc_raw", XS_main_alloc_raw, __FILE__, "$");
(void)newXSproto_portable("main::set_mem_u128", XS_main_set_mem_u128, __FILE__, "$$$");
(void)newXSproto_portable("main::get_string_ptr", XS_main_get_string_ptr, __FILE__, "");
(void)newXSproto_portable("main::test_invoke_callback", XS_main_test_invoke_callback, __FILE__, "$$$");
(void)newXSproto_portable("main::test_invoke_callback_128", XS_main_test_invoke_callback_128, __FILE__, "$$");
(void)newXSproto_portable("main::get_file_ptr", XS_main_get_file_ptr, __FILE__, "$");
(void)newXSproto_portable("main::verify_marshalling_128", XS_main_verify_marshalling_128, __FILE__, "$");
(void)newXSproto_portable("main::mock_cxx_new", XS_main_mock_cxx_new, __FILE__, "$");
(void)newXSproto_portable("main::mock_cxx_delete", XS_main_mock_cxx_delete, __FILE__, "$");
(void)newXSproto_portable("main::get_mock_cxx_dtor", XS_main_get_mock_cxx_dtor, __FILE__, "");
(void)newXSproto_portable("main::get_mock_cxx_dtor_calls", XS_main_get_mock_cxx_dtor_calls, __FILE__, "");
//(void)newXSproto_portable("::is_pin", XS_main_is_pin, __FILE__, nullptr);
}
#undef XSUB_EXPORT
Perl_xs_boot_epilog(aTHX_ ax);
}
lib/Affix.pod view on Meta::CPAN
}
B<Note:> You must call C<errno()> immediately after the C function invokes, as subsequent Perl operations (like
printing to STDOUT) might overwrite the system's error register.
=head2 Memory Inspection
=head3 C<dump( $pin, $length_in_bytes )>
Prints a formatted hex dump of the memory pointed to by a Pin directly to C<STDOUT>. This is an invaluable tool for
verifying that C structs or buffers contain the data you expect.
my $ptr = strdup("Affix Debugging");
dump($ptr, 16);
# Output:
# Dumping 16 bytes from 0x55E9A8A5 at script.pl line 42
# 000 41 66 66 69 78 20 44 65 62 75 67 67 69 6e 67 00 | Affix Debugging.
=head3 C<sv_dump( $scalar )>
lib/Affix/marshal.c view on Meta::CPAN
typedef struct {
unsigned __int128 val;
int id;
} BigData;
void mutate_big_data_native(BigData * d) {
d->val += 1; /* Add 1 to the 128-bit int natively */
d->id = 777;
}
void verify_marshalling_128(pTHX_ SV * input) {
dMY_CXT;
const infix_type * type = infix_registry_lookup_type(MY_CXT.registry, "BigData");
BigData stack_struct = {0, 0};
if (SvROK(input)) {
SV * proxy = newSV(0);
sv_setsv(proxy, input);
bind_placeholder(aTHX_ proxy, &stack_struct, type, 0, 0, false, nullptr, nullptr, false, false);
MAGIC * mg = mg_find(proxy, PERL_MAGIC_ext);
if (mg && mg->mg_virtual->svt_set)
mg->mg_virtual->svt_set(aTHX_ proxy, mg);
lib/Affix/marshal.c view on Meta::CPAN
{
SV * fh_ref = ST(0);
IV RETVAL;
dXSTARG;
RETVAL = get_file_ptr(aTHX_ fh_ref);
TARGi((IV)RETVAL, 1);
ST(0) = TARG;
}
XSRETURN(1);
}
XS_INTERNAL(XS_main_verify_marshalling_128) {
dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "input");
verify_marshalling_128(aTHX_ ST(0));
XSRETURN_EMPTY;
}
XS_INTERNAL(XS_main_mock_cxx_new) {
dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "v");
{
int v = (int)SvIV(ST(0));
lib/Affix/marshal.c view on Meta::CPAN
int RETVAL;
dXSTARG;
RETVAL = get_mock_cxx_dtor_calls();
TARGi((IV)RETVAL, 1);
ST(0) = TARG;
}
XSRETURN(1);
}
/**
* @brief Helper to verify if a VTable belongs to the Affix system (v1 or v2).
*/
int is_v2_vtable(MGVTBL * v) {
if (!v)
return 0;
return (v == &vtbl_sint8 || v == &vtbl_uint8 || v == &vtbl_sint16 || v == &vtbl_uint16 || v == &vtbl_sint32 ||
v == &vtbl_uint32 || v == &vtbl_sint64 || v == &vtbl_uint64 || v == &vtbl_sint128 || v == &vtbl_uint128 ||
v == &vtbl_float || v == &vtbl_double || v == &vtbl_float16 || v == &vtbl_bool || v == &vtbl_void ||
v == &vtbl_bitfield || v == &vtbl_pointer || v == &vtbl_array || v == &string_vtable ||
v == &wstring_vtable || v == &vtbl_lazy_aggregate || v == &vtbl_enum || v == &vtbl_buffer);
}
t/007_pointers.t view on Meta::CPAN
# 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 = cast( malloc( sizeof(Int) ), Array [ Int, 1 ] );
# Test magical 'set' via dereferencing
# $int_ptr is an array ref bound directly to the C memory
$int_ptr->[0] = 42;
# Use the original $mem pointer for reading (verifying they point to the same place)
is read_int_from_void_ptr($int_ptr), 42, 'Magical set via deref wrote to C memory';
# Test cast again
my $long_ptr = cast( $mem, Pointer [LongLong] );
$$long_ptr = 1234567890123;
is $$long_ptr, 1234567890123, 'Magical get after casting to a new type works';
# Test realloc
my $r_ptr = calloc( 2, sizeof Int );
t/009_128bit.t view on Meta::CPAN
DLLEXPORT int has_int128() { return 1; }
DLLEXPORT int128 add_i128(int128 a, int128 b) {
return a + b;
}
DLLEXPORT uint128 add_u128(uint128 a, uint128 b) {
return a + b;
}
// Helper to verify value passed correctly (returns high 64 bits cast to 64)
DLLEXPORT int64_t high_bits_i128(int128 v) {
return (int64_t)(v >> 64);
}
#else
DLLEXPORT int has_int128() { return 0; }
#endif
END_C
# Compile the library
my $lib = compile_ok($c_source);
t/019_fileio.t view on Meta::CPAN
}
return fp;
}
// Identity function to test round-tripping a PerlIO pointer.
// Since we don't link against libperl here, we treat PerlIO* as void*.
DLLEXPORT void* c_perlio_identity(void* p) {
return p;
}
// Check if FILE* is NULL (to verify failure cases)
DLLEXPORT int c_is_null_file(FILE* fp) {
return fp == NULL;
}
END_C
subtest 'Standard C FILE* (Affix::File)' => sub {
# File represents the FILE struct, so Pointer[File] is FILE*
affix $lib, 'c_write_to_file', [ Pointer [File], String ] => Int;
affix $lib, 'c_read_char', [ Pointer [File] ] => Int;
affix $lib, 'c_create_tmpfile', [] => Pointer [File];
t/019_fileio.t view on Meta::CPAN
# Pass filehandle to C to store in struct
init_logger( $logger, $fh );
# Verify via C function
log_message( $logger, 'First message' );
log_message( $logger, 'Second message' );
# Verify Perl side struct access
# Note: Pulling a File handle usually creates a new GLOB wrapper around the FILE*
# Since we own $fh, let's verify checking against undef works
my $logger_struct = cast( $logger, Logger() ); # View as struct
my $retrieved_fh = $logger_struct->{log_file};
ok $retrieved_fh, 'Retrieved filehandle from struct';
is ref($retrieved_fh), 'GLOB', 'It is a glob';
# Write from Perl using retrieved handle
# print {$retrieved_fh} "From Perl"; # Careful, might double-close if not careful
# Check file content
open my $check, '<', $filename;
my @lines = <$check>;
t/019_fileio.t view on Meta::CPAN
my $old_fh = select($fh);
$| = 1;
select($old_fh);
# Call C function returning a struct by value
my $logger_hash = create_logger($fh);
is $logger_hash->{counter}, 100, 'Counter is correct';
ok $logger_hash->{log_file}, 'Got filehandle back';
is ref( $logger_hash->{log_file} ), 'GLOB', 'It is a glob';
# Write using the returned handle to verify it works
# Note: $logger_hash->{log_file} wraps the same FILE* as $fh.
ok syswrite( $logger_hash->{log_file}, "Direct write from Perl" ), 'syswrite to the handle from Perl';
# To avoid double-close warnings, we let Perl handle cleanup of the glob
# but be careful about explicit closes.
undef $logger_hash;
# Check
open my $check, '<', $filename;
my $content = <$check>;
t/020_deep_types.t view on Meta::CPAN
ok $ptr, 'Got a pointer';
# No dereference needed. $ptr is the HashRef representing the C struct.
is $ptr, { top_left => { x => 0, y => 0 }, bottom_right => { x => 10, y => 20 } }, 'Struct pointer correctly mapped to HashRef';
# Modify via pointer (deep write back to C memory)
# Assigning to the magical HashRef triggers deep synchronization via VTables
$ptr->{top_left} = { x => 99, y => 99 };
$ptr->{bottom_right} = { x => 100, y => 100 };
# Read again to verify round-trip
is $ptr->{top_left}{x}, 99, 'Write-back to static C struct via magic successful';
# Verify it persists (call the C accessor again)
my $ptr2 = $get_static_rect->();
is $ptr2->{top_left}{x}, 99, 'Changes persisted in C memory';
};
#
done_testing;
t/023_sockaddr.t view on Meta::CPAN
#include "std.h"
//ext: .c
// Minimal definition to ensure struct layout matches system
#if defined(_WIN32)
#include <winsock2.h>
#else
#include <netinet/in.h>
#endif
// We implement a manual byte swap to verify the data arrived correctly
// without needing to link against system network libraries (ws2_32.dll etc)
// which simplifies the test build process.
DLLEXPORT int get_port_raw(struct sockaddr_in* sa) {
if (!sa) return -1;
// Return raw network-byte-order value
return sa->sin_port;
}
DLLEXPORT unsigned long get_addr(struct sockaddr_in* sa) {
if (!sa) return 0;
t/023_sockaddr.t view on Meta::CPAN
# Verify Port
# C returns raw network short (Big Endian).
# unpack('n') converts "Network to Native".
my $raw_port_from_c = get_port_raw($sa);
my $port_back = unpack 'n', pack 'S', $raw_port_from_c;
# On Little Endian systems (x86), pack('S') puts the bytes in LE.
# But wait, C returned a UShort (number).
# If C read 0x1F90 (8080) from memory as a short on LE, it saw 0x901F (36895).
# Let's just verify round-trip logic via 'n' (Network order).
# Simpler check: Just pack the Perl port into network order and compare values
my $expected_raw_port = unpack 'S', pack( 'n', $port );
is $raw_port_from_c, $expected_raw_port, 'Port passed correctly (Network Byte Order preserved)';
# Verify IP
# IP is just a 32-bit int, raw
my $raw_addr = get_addr($sa);
my $expected_addr = unpack 'L', inet_aton($ip);
is $raw_addr, $expected_addr, 'IP address passed correctly';
done_testing;
t/035_magic_struct.t view on Meta::CPAN
my $tx = cast $root_ptr, Transform();
# Grab a reference to a nested struct
$sub_hash = $tx->{origin};
}
# Attempt to write to the sub-hash after parent is technically "gone"
$sub_hash->{y} = 77;
# If we are here and haven't crashed, success.
# We can verify by re-pinning a pointer to see if the value is there.
is $sub_hash->{y}, 77, 'Sub-struct remains valid and writable after parent scope ends';
};
subtest 'Magical Array Indexing (Primitives)' => sub {
# Allocate memory for 5 integers
my $ptr = Affix::malloc( sizeof( Array [ Int, 5 ] ) );
memset( $ptr, 0, sizeof( Array [ Int, 5 ] ) );
# Cast to Pointer[Int] so Affix knows the element size
$ptr = cast( $ptr, Array [ Int, 5 ] );
t/060_platform_unix_security.t view on Meta::CPAN
# Malicious input must not execute shell commands.
# With list-form open, the entire string "-lm; echo INJECTED" is passed as a
# single argument to ld — never interpreted by a shell.
for my $evil ( 'm; echo INJECTED', 'm && touch /tmp/pwned', 'm | cat /etc/passwd', 'm $(id)', 'm`id`', ) {
( $out, $err, $exit ) = capture { Affix::Platform::Unix::_findLib_ld($evil) };
my $combined = ( $out // '' ) . ( $err // '' );
# The shell injection payload must NOT appear as executed output
unlike $combined, qr/^INJECTED$/m, "No shell injection via ld: $evil";
# On systems where ld exists, verify the malicious string is passed as a
# single argument (ld will complain about "cannot find -l<entire string>")
if ( $combined =~ /cannot find/ ) {
like $combined, qr/\Q$evil\E/, "Malicious string passed as single arg to ld: $evil";
}
}
};
subtest '_findLib_gcc: safe command execution (C3)' => sub {
# Normal call — may return empty without gcc, must not die
my @result = eval { Affix::Platform::Unix::_findLib_gcc('m') };
t/081_packed.t view on Meta::CPAN
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';
t/084_enum_aliases.t view on Meta::CPAN
typedef enum {
MODE_READ = 0,
MODE_WRITE = 1,
MODE_EXEC = 2
} FileMode;
DLLEXPORT int check_mode(FileMode m) { return m; }
DLLEXPORT FileMode next_mode(FileMode m) { return (m + 1) % 3; }
DLLEXPORT char get_char_val(void) { return 42; }
DLLEXPORT int verify_char_range(signed char v) { return (v >= -128 && v <= 127) ? 1 : 0; }
DLLEXPORT unsigned int get_uint_val(void) { return 300; }
DLLEXPORT int verify_uint(unsigned int v) { return (v == 300) ? 1 : 0; }
END_C
#
my $lib = compile_ok($C_CODE);
ok( $lib && -e $lib, 'Compiled shared library' );
#
subtest 'IntEnum -- same as Enum' => sub {
typedef Mode => Affix::IntEnum [ [ MODE_READ => 0 ], [ MODE_WRITE => 1 ], [ MODE_EXEC => 2 ] ];
# Use affix to install into current package (avoids bareword issues)
affix $lib, 'check_mode', ['@Mode'] => Int;
t/084_enum_aliases.t view on Meta::CPAN
is check_mode( MODE_WRITE() ), 1, 'check_mode(MODE_WRITE) returns 1';
is check_mode( MODE_EXEC() ), 2, 'check_mode(MODE_EXEC) returns 2';
my $next_state = next_mode( MODE_READ() );
is $next_state + 0, 1, 'next_mode(MODE_READ) numerically equals 1';
};
#
subtest 'CharEnum -- 1-byte signed char' => sub {
typedef SmallMode => Affix::CharEnum [ [ SM_OFF => 0 ], [ SM_ON => 1 ], [ SM_MAX => 127 ] ];
is sizeof( SmallMode() ), 1, 'CharEnum is 1 byte';
affix $lib, 'get_char_val', [] => Char;
affix $lib, 'verify_char_range', [Char] => Bool;
is get_char_val(), 42, 'get_char_val() returns 42 (fits in char)';
ok verify_char_range( 42), 'char 42 is in range';
ok verify_char_range(-128), 'char -128 is in range';
ok verify_char_range( 127), 'char 127 is in range';
};
#
subtest 'UIntEnum -- unsigned int' => sub {
typedef UMode => Affix::UIntEnum [ [ UOFF => 0 ], [ UON => 1 ], [ UMAX => 4294967295 ] ];
is sizeof( UMode() ), 4, 'UIntEnum is 4 bytes (unsigned int)';
is UOFF(), 0, 'UOFF constant is 0';
is UMAX(), 4294967295, 'UMAX constant is 2^32-1';
affix $lib, 'get_uint_val', [] => UInt;
affix $lib, 'verify_uint', [UInt] => Bool;
is get_uint_val(), 300, 'get_uint_val() returns 300';
ok verify_uint(300), 'verify_uint(300) returns true';
};
#
subtest 'CharEnum -- negative values' => sub {
typedef SByte => Affix::CharEnum [ [ NEG_MAX => -128 ], [ NEG_MID => -1 ], [ ZERO => 0 ], [ POS_MID => 1 ], [ POS_MAX => 127 ] ];
is NEG_MAX(), -128, 'CharEnum NEG_MAX is -128';
is NEG_MID(), -1, 'CharEnum NEG_MID is -1';
is ZERO(), 0, 'CharEnum ZERO is 0';
is POS_MID(), 1, 'CharEnum POS_MID is 1';
is POS_MAX(), 127, 'CharEnum POS_MAX is 127';
};
t/999_marshaller_2.t view on Meta::CPAN
char name[32];
Task tasks[2]; // Array inside struct
} Employee;
typedef struct {
Employee *manager; // Pointer inside struct
int budget;
} Company;
// Verification function
DLLEXPORT bool verify_hierarchy(Company *c) {
if (!c || !c->manager) return false;
warn("# c: Company { budget: %d, manager: '%s' }", c->budget, c->manager->name);
warn("# c: Manager Task 0: [%d] %s", c->manager->tasks[0].id, c->manager->tasks[0].name);
return (c->budget == 50000 &&
strcmp(c->manager->name, "Alice") == 0 &&
c->manager->tasks[0].id == 101);
}
t/999_marshaller_2.t view on Meta::CPAN
# Pass the magical pin to FFI (By Pointer)
# Affix will use get_address_v2 to resolve the pointer
ok check_pos_ptr($p), 'FFI check_pos_ptr($p) - passed by pointer';
diag sprintf( "Address: 0x%X", address($p) );
};
subtest company => sub {
typedef Task => Struct [ id => Int, name => Array [ Char, 16 ] ];
typedef Employee => Struct [ name => Array [ Char, 32 ], tasks => Array [ Task(), 2 ] ];
typedef Company => Struct [ manager => Pointer [ Employee() ], budget => Int ];
#
affix $lib_path, 'verify_hierarchy', [ Pointer [ Company() ] ], Bool;
# Setup nested data in C memory
ok my $mem_comp = alloc_owned( sizeof( Company() ) ), 'alloc Company';
ok my $mem_mgr = alloc_owned( sizeof( Employee() ) ), 'alloc Manager';
ok my $comp = cast( $mem_comp, Company() ), 'cast Company';
ok my $mgr = cast( $mem_mgr, Employee() ), 'cast Manager';
# Link them via pointer
$comp->{manager} = address($mgr);
$comp->{budget} = 50000;
t/999_marshaller_2.t view on Meta::CPAN
is $comp->{manager}{tasks}[0]{id}, 101, 'Deep Read: manager->tasks[0]->id';
# TEST DEEP WRITE via the pointer member
$comp->{manager}{tasks}[0]{id} = 999;
is $mgr->{tasks}[0]{id}, 999, 'Deep Write confirmed in original memory';
# Reset for verification function
$comp->{manager}{tasks}[0]{id} = 101;
# Pass to C
ok verify_hierarchy($comp), 'FFI: verify_hierarchy($comp) - deep validation passed';
};
subtest 'smart & safety' => sub {
# Types were defined in previous subtests
affix $lib_path, 'get_null_company', [], Pointer [ Company() ];
ok my $mem_comp = alloc_owned( sizeof( Company() ) ), 'alloc Company';
ok my $mem_mgr = alloc_owned( sizeof( Employee() ) ), 'alloc Manager';
ok my $comp = cast( $mem_comp, Company() ), 'cast Company';
ok my $mgr = cast( $mem_mgr, Employee() ), 'cast Manager';
$mgr->{name} = "Bob";
( run in 1.781 second using v1.01-cache-2.11-cpan-9789f410c06 )