Affix
view release on metacpan or search on metacpan
builder/Affix/Builder.pm view on Meta::CPAN
.= ' -DNDEBUG -DBOOST_DISABLE_ASSERTS -O3 -ftree-vectorize -ffast-math -fno-align-functions -fno-align-loops -fno-omit-frame-pointer -flto';
}
# Threading support (Critical for shm_open/librt on Linux)
if ( !$is_win ) {
$cflags .= ' -pthread';
$ldflags .= ' -pthread';
}
}
method write_file( $filename, $content ) { path($filename)->spew_raw($content) or die "Could not open $filename: $!\n" }
method read_file ($filename) { path($filename)->slurp_utf8 or die "Could not open $filename: $!\n" }
method step_build() {
$self->step_affix;
my %modules = map { $_ => catfile( 'blib', $_ ) } find( qr/\.pm$/, 'lib' );
my %docs = map { $_ => catfile( 'blib', $_ ) } find( qr/\.pod$/, 'lib' );
my %scripts = map { $_ => catfile( 'blib', $_ ) } find( qr/(?:)/, 'script' );
my %sdocs = map { $_ => delete $scripts{$_} } grep {/.pod$/} keys %scripts;
my %dist_shared = map { $_ => catfile( qw[blib lib auto share dist], $meta->name, abs2rel( $_, 'share' ) ) } find( qr/(?:)/, 'share' );
my %module_shared = map { $_ => catfile( qw[blib lib auto share module], abs2rel( $_, 'module-share' ) ) } find( qr/(?:)/, 'module-share' );
pm_to_blib( { %modules, %docs, %scripts, %dist_shared, %module_shared }, catdir(qw[blib lib auto]) );
lib/Affix.c view on Meta::CPAN
UV uv = (UV)*s++;
// Handle Windows Surrogate Pairs (UTF-16LE)
if (sizeof(wchar_t) == 2 && uv >= 0xD800 && uv <= 0xDBFF) {
if (*s >= 0xDC00 && *s <= 0xDFFF) {
UV low = (UV)*s++;
uv = ((uv - 0xD800) << 10) + (low - 0xDC00) + 0x10000;
}
}
d = (char *)uvchr_to_utf8((U8 *)d, uv);
}
*d = 0;
// Set Perl SV properties
SvCUR_set(sv, d - SvPVX(sv));
SvPOK_on(sv);
SvUTF8_on(sv);
}
// Direct marshalling experiment
lib/Affix.c view on Meta::CPAN
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_WCHAR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
if (SvPOK(sv)) { \
STRLEN len; \
U8 * s = (U8 *)SvPVutf8(sv, len); \
U8 * e = s + len; \
Newx(*(void **)ptr, len + 1, wchar_t); \
wchar_t * d = *(void **)ptr; \
while (s < e) { \
UV uv = utf8_to_uvchr_buf(s, e, nullptr); \
if (sizeof(wchar_t) == 2 && uv > 0xFFFF) { \
uv -= 0x10000; \
*d++ = (wchar_t)((uv >> 10) + 0xD800); \
*d++ = (wchar_t)((uv & 0x3FF) + 0xDC00); \
} \
else \
*d++ = (wchar_t)uv; \
s += UTF8SKIP(s); \
} \
*d = 0; \
lib/Affix.pod view on Meta::CPAN
=pod
=encoding utf-8
=head1 NAME
Affix - A Foreign Function Interface eXtension
=head1 SYNOPSIS
use v5.40;
use Affix qw[:all];
lib/Affix/Build.pm view on Meta::CPAN
my ( $path, $lang );
if ( ref $input eq 'SCALAR' ) { # Inline source code
$args{lang} // croak q[Parameter 'lang' (extension) is required for inline source];
$lang = lc $args{lang};
croak "Invalid language '$lang'" unless $lang =~ /^[a-z0-9+#]+$/;
# Generate a unique filename in the build dir
state $counter = 0;
my $fname = sprintf( "source_%03d.%s", ++$counter, $lang );
$path = $build_dir->child($fname);
$path->spew_utf8($$input);
}
else { # File path
$path = Path::Tiny::path($input)->absolute;
croak "File not found: $path" unless $path->exists;
($lang) = $path =~ /\.([^.]+)$/;
$lang = lc( $lang // '' );
}
# Handle local flags
my $local_flags = $args{flags} // [];
lib/Affix/Build.pm view on Meta::CPAN
method _build_dotnet ( $src, $out, $mode, $lang ) {
my $file = $src->{path};
my $dotnet = $self->_can_run('dotnet') // croak "Dotnet not found";
my $proj_dir = $build_dir->child( "dotnet_${lang}_" . $self->_base($file) );
$proj_dir->mkpath;
$file->copy( $proj_dir->child( $file->basename ) );
my $ext = $lang eq 'fs' ? 'fsproj' : 'csproj';
my $proj = $proj_dir->child("Build.$ext");
my $lib_type = ( $mode eq 'dynamic' ) ? 'Shared' : 'Static';
my $items = $lang eq 'fs' ? '<ItemGroup><Compile Include="**/*.fs" /></ItemGroup>' : '';
$proj->spew_utf8(<<"XML");
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<PublishAot>true</PublishAot>
<NativeLib>$lib_type</NativeLib>
<SelfContained>true</SelfContained>
</PropertyGroup>
$items
</Project>
XML
lib/Affix/Build.pod view on Meta::CPAN
=pod
=encoding utf-8
=head1 NAME
Affix::Build - Polyglot Compiler Frontend for Building FFI Extensions in Everything from Assembly to Zig
=head1 SYNOPSIS
use v5.40;
use Affix::Build;
use Affix;
lib/Affix/Wrap.pm view on Meta::CPAN
args => \@args,
doc => $self->_doc_w_trail( $f, $s, $e ),
start_offset => $s,
end_offset => $e
);
}
method _get_content($f) {
my $abs = $self->_normalize($f);
return $file_cache->{$abs} if exists $file_cache->{$abs};
if ( -e $abs ) { return $file_cache->{$abs} = Path::Tiny::path($abs)->slurp_utf8; }
return '';
}
method _extract_doc( $f, $off ) {
return undef unless defined $off;
my $content = $self->_get_content($f);
return undef unless length($content);
my $pre = substr( $content, 0, $off );
my @lines = split /\n/, $pre;
my @d;
lib/Affix/Wrap.pm view on Meta::CPAN
if ( $f =~ /\.h(pp|xx)?$/i ) { $self->_scan( $f, \@objs ); $self->_scan_funcs( $f, \@objs ); }
else { $self->_scan_funcs( $f, \@objs ); }
}
@objs = sort { ( $a->file cmp $b->file ) || ( $a->start_offset <=> $b->start_offset ) } @objs;
@objs;
}
method _read($f) {
my $abs = $self->_normalize($f);
return $file_cache->{$abs} if exists $file_cache->{$abs};
return $file_cache->{$abs} = Path::Tiny::path($f)->slurp_utf8;
}
method _scan( $f, $acc ) {
my $c = $self->_read($f);
# Macros
while ( $c =~ /^\s*#\s*define\s+(\w+)(?:[ \t]+(.*?))?$/gm ) {
my $name = $1;
my $val = $2 // '';
my $s = $-[0];
lib/Affix/Wrap.pm view on Meta::CPAN
my $code = $node->affix_type;
if ( $code && ( $node isa Affix::Wrap::Function || $node isa Affix::Wrap::Variable || $node isa Affix::Wrap::Macro ) ) {
$out .= " $code;\n";
}
}
$out .= "};\n1;\n";
}
method generate( $lib, $pkg, $file ) {
my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
Path::Tiny::path($file)->spew_utf8($code);
}
method wrap ( $lib, $pkg //= [caller]->[0] ) {
my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
eval $code;
if ($@) {
Carp::croak("Affix::Wrap wrap() compilation failed: $@\n\nCode:\n$code");
}
return grep { $_ isa Affix::Wrap::Function || $_ isa Affix::Wrap::Variable || $_ isa Affix::Wrap::Macro } @$nodes;
}
lib/Affix/Wrap.pod view on Meta::CPAN
=pod
=encoding utf-8
=head1 NAME
Affix::Wrap - Automatic Generation of FFI Wrappers for Shared Libraries Written in C or C++
=head1 SYNOPSIS
use Affix::Wrap;
my $wrapper = Affix::Wrap->new(
lib/Affix/marshal.c view on Meta::CPAN
for (size_t i = 0; i < act; i++) {
UV cp = (el_sz == 2) ? ((uint16_t *)im->ptr)[i] : ((uint32_t *)im->ptr)[i];
/* Combine Surrogate Pairs for UTF-16 */
if (el_sz == 2 && cp >= 0xD800 && cp <= 0xDBFF && i + 1 < act) {
uint16_t low = ((uint16_t *)im->ptr)[i + 1];
if (low >= 0xDC00 && low <= 0xDFFF) {
cp = 0x10000 + (((cp - 0xD800) << 10) | (low - 0xDC00));
i++;
}
}
d = uvchr_to_utf8(d, cp);
}
*d = '\0';
sv_setpvn(sv, (char *)buf, d - buf);
SvUTF8_on(sv);
safefree(buf);
SvSMAGICAL_on(sv);
return 0;
}
/**
lib/Affix/marshal.c view on Meta::CPAN
croak("Modification of a read-only C value attempted");
if (!im->ptr)
return 0;
const infix_type * t = resolve_type(aTHX_ im->type);
size_t max_len = t->meta.array_info.num_elements;
size_t el_sz = t->meta.array_info.element_type->size;
if (max_len == 0)
return 0;
SvGMAGICAL_off(sv);
STRLEN len;
char * str = SvPVutf8(sv, len);
U8 * p = (U8 *)str;
U8 * pend = p + len;
size_t i = 0;
while (p < pend && i < max_len - 1) {
STRLEN rlen;
UV cp = utf8_to_uvchr_buf(p, pend, &rlen);
if (rlen == 0)
break;
p += rlen;
if (cp == 0)
break;
/* Split UTF-8 back into UTF-16 Surrogate Pairs if applicable */
if (el_sz == 2 && cp > 0xFFFF) {
/* Truncation safety: Don't write half a pair if buffer is almost full */
if (i < max_len - 2) {
cp -= 0x10000;
lib/Affix/marshal.c view on Meta::CPAN
U8 * d = buf;
for (size_t i = 0; i < act; i++) {
UV cp = (el_sz == 2) ? ((uint16_t *)ws)[i] : ((uint32_t *)ws)[i];
if (el_sz == 2 && cp >= 0xD800 && cp <= 0xDBFF && i + 1 < act) {
uint16_t low = ((uint16_t *)ws)[i + 1];
if (low >= 0xDC00 && low <= 0xDFFF) {
cp = 0x10000 + (((cp - 0xD800) << 10) | (low - 0xDC00));
i++;
}
}
d = uvchr_to_utf8(d, cp);
}
*d = '\0';
sv_setpvn(sv, (char *)buf, d - buf);
SvUTF8_on(sv);
safefree(buf);
}
else {
/* Unwrap terminal string/void protections for the inner pin if needed */
const infix_type * pin_type = _unwrap_pin_type(pointee);
lib/Affix/marshal.c view on Meta::CPAN
pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT8)) {
new_addr = (void *)SvPV_nolen(sv);
}
else if (pointee->category == INFIX_TYPE_PRIMITIVE && pointee->size == sizeof(wchar_t) &&
(pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT16 ||
pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT32)) {
/* WString (wchar_t*): convert the Perl UTF-8 string to UTF-16/32.
Mirror CASE_OP_PUSH_PTR_WCHAR. Buffer lifetime matches the pin's
arena (struct liveness) when available, mirroring StringList. */
STRLEN wlen;
U8 * s = (U8 *)SvPVutf8(sv, wlen);
U8 * e = s + wlen;
size_t el_sz = pointee->size;
wchar_t * wbuf = (wchar_t *)(im->arena ? infix_arena_alloc(im->arena, (wlen + 1) * el_sz, el_sz)
: safemalloc((wlen + 1) * el_sz));
wchar_t * d = wbuf;
while (s < e) {
UV uv = utf8_to_uvchr_buf(s, e, nullptr);
if (el_sz == 2 && uv > 0xFFFF) {
uv -= 0x10000;
*d++ = (wchar_t)((uv >> 10) + 0xD800);
*d++ = (wchar_t)((uv & 0x3FF) + 0xDC00);
}
else
*d++ = (wchar_t)uv;
s += UTF8SKIP(s);
}
*d = 0;
lib/Test2/Tools/Affix.pm view on Meta::CPAN
else {
$opt = tempfile(
UNLINK => !$keep,
SUFFIX => '_' . path( [ caller() ]->[1] )->basename . ( $name =~ m[^\s*//\s*ext:\s*\.c$]ms ? '.c' : '.cxx' )
)->absolute;
push @cleanup, $opt unless $keep;
my ( $package, $filename, $line ) = caller;
$filename = path($filename)->canonpath;
$line++;
$filename =~ s[\\][\\\\]g; # Windows...
$opt->spew_utf8(qq[#line $line "$filename"\r\n$name]);
}
if ( !$opt ) {
$c->fail('Failed to locate test source');
$c->release;
return ();
}
$aggs->{cflags} .= ' -I' . $Inc;
my $compiler = Affix::Build->new( debug => 0, name => 'testing', version => '1.0', flags => $aggs );
$compiler->add( $opt->canonpath );
$compiler->link;
lib/Test2/Tools/Affix.pm view on Meta::CPAN
# $out =~ s[# Seeded srand with seed .+$][]m;
# $err =~ s[# Tests were run .+$][];
if ( $out =~ m[\S] ) {
$out =~ s[^((?:[ \t]*))(?=\S)][$1 ]gm;
print $out;
}
if ( $err =~ m[\S] ) {
$err =~ s[^((?:[ \t]*))(?=\S)][$1 ]gm;
print STDERR $err;
}
my $parsed = parse_xml( $report->slurp_utf8 );
# use Data::Dump;
# ddx $parsed;
# diag 'exit: '. $exit;
# Test2::API::test2_stack()->top->{count}++;
ok !$exit && !$parsed->{valgrindoutput}{errorcounts}, $name;
}
}
END {
t/017_affix_build.t view on Meta::CPAN
= $lang eq 'rust' ? 'rs' :
$lang eq 'csharp' ? 'cs' :
$lang eq 'fsharp' ? 'fs' :
$lang eq 'fortran' ? 'f90' :
$lang eq 'pascal' ? 'pas' :
$lang eq 'crystal' ? 'cr' :
$lang eq 'assembly' ? 'asm' :
$lang eq 'cobol' ? 'cbl' :
$lang;
my $src = $TMP_DIR->child("test_$lang.$ext");
$src->spew_utf8($code);
#
my $c = Affix::Build->new( build_dir => $TMP_DIR, name => "${lang}_lib" );
$c->add($src);
try { $c->compile_and_link() }
catch ($err) {
skip_all 'Link failed (toolchain issue?): ' . $err;
return;
}
pass 'Linked successfully';
#
t/017_affix_build.t view on Meta::CPAN
PROCEDURE DIVISION USING A, B, R.
ADD A TO B GIVING R.
GOBACK.
END PROGRAM add_cob.
subtest 'Polyglot: Number Cruncher (C + Fortran + ASM)' => sub {
skip_all "Missing compilers" unless bin_path( $Config{cc} ) && bin_path('gfortran');
# C is our orchestrator
my $c_src = $TMP_DIR->child('math_core.c');
$c_src->spew_utf8(<<~'C');
#include <stdio.h>
#ifdef _WIN32
__declspec(dllexport)
#endif
int core_version() { return 1; }
C
# Fortran does the math
my $f_src = $TMP_DIR->child('math_algos.f90');
$f_src->spew_utf8(<<~'F90');
function fortran_add(a, b) bind(c, name='fortran_add')
use iso_c_binding
integer(c_int), value :: a, b
integer(c_int) :: fortran_add
fortran_add = a + b
end function
F90
# Assembly for optimization
my $asm_bin;
t/017_affix_build.t view on Meta::CPAN
$asm_src = <<~'' }
global asm_inc
section .text
asm_inc:
mov eax, edi
inc eax
ret
skip_all "Missing Assembler ($asm_bin)" unless bin_path($asm_bin);
my $asm_file = $TMP_DIR->child($asm_file_name);
$asm_file->spew_utf8($asm_src);
#
my $compiler = Affix::Build->new( name => 'number_cruncher', build_dir => $TMP_DIR );
$compiler->add($c_src);
$compiler->add($f_src);
$compiler->add($asm_file);
ok( lives { $compiler->link() }, 'Linked Number Cruncher' ) or note $@;
ok( $compiler->libname->exists, 'Library exists' );
enjoin( $compiler->libname, 'core_version', 'fortran_add', 'asm_inc' );
};
subtest 'Polyglot: Modern Stack (C++ + Rust + Zig)' => sub {
skip_all 'Missing compilers' unless bin_path('g++') && bin_path('rustc') && bin_path('zig');
skip_all 'Rust/MinGW target missing' unless check_rust_gnu();
# C++ for ease of ABI
my $cpp_src = $TMP_DIR->child('interface.cpp');
$cpp_src->spew_utf8(<<~'');
extern "C" {
#ifdef _WIN32
__declspec(dllexport)
#endif
int cpp_interface() { return 2025; }
}
# Rust for safety
my $rs_src = $TMP_DIR->child('safety.rs');
$rs_src->spew_utf8(<<~'');
#[no_mangle]
pub extern "C" fn rust_safe_add(a: i32, b: i32) -> i32 {
a + b
}
# Zig for logic
my $zig_src = $TMP_DIR->child('logic.zig');
$zig_src->spew_utf8(<<~'');
export fn zig_calc() i32 {
return 42;
}
#
my $compiler = Affix::Build->new( name => 'modern_stack', build_dir => $TMP_DIR );
$compiler->add($cpp_src);
$compiler->add($rs_src);
$compiler->add($zig_src);
ok( lives { $compiler->link() }, 'Linked Modern Stack' ) or note $@;
t/017_affix_build.t view on Meta::CPAN
push @reqs, $Config{cc}; # System CC
push @reqs, ( $Config{archname} =~ /arm64/ ? $Config{cc} : 'nasm' );
push @reqs, 'rustc';
for my $bin (@reqs) {
skip_all "Missing $bin" unless bin_path($bin);
}
skip_all 'Rust/MinGW target missing' unless check_rust_gnu();
my $c = Affix::Build->new( name => 'mega_lib', build_dir => $TMP_DIR );
#
my $f1 = $TMP_DIR->child('f1.c');
$f1->spew_utf8(<<~'');
#ifdef _WIN32
__declspec(dllexport)
#endif
int func_c( ) { return 1; }
$c->add($f1);
#
my $f2 = $TMP_DIR->child('f2.cpp');
$f2->spew_utf8(<<~'');
extern "C" {
#ifdef _WIN32
__declspec(dllexport)
#endif
int func_cpp( ) { return 2; }
}
$c->add($f2);
#
my $f3 = $TMP_DIR->child('f3.rs');
$f3->spew_utf8(<<~'');
#[no_mangle]
pub extern "C" fn func_rs( )->i32{ 3 }
$c->add($f3);
#
my $f4 = $TMP_DIR->child('f4.zig');
$f4->spew_utf8(<<~'');
export fn func_zig() i32 { return 4; }
$c->add($f4);
#
my $f5 = $TMP_DIR->child('f5.d');
$f5->spew_utf8( ( $^O eq 'MSWin32' ? <<~'' : '' ) . <<~'' );
import core.sys.windows.dll;
mixin SimpleDllMain;
export
extern(C) int func_d() { return 5; }
$c->add($f5);
#
my $f6 = $TMP_DIR->child('f6.f90');
$f6->spew_utf8(<<~'');
function func_f() bind(c, name='func_f')
use iso_c_binding
integer(c_int) :: func_f
func_f=6
end function
$c->add($f6);
#
my $asm_ext = ( $Config{archname} =~ /arm64/ ) ? 's' : 'asm';
my $f7 = $TMP_DIR->child("f7.$asm_ext");
$f7->spew_utf8( ( $^O eq 'MSWin32' || $Config{archname} !~ /arm64/ ) ? <<~'' : <<~'' );
; x86/x64
global func_asm
section .text
func_asm:
mov eax, 7
ret
; ARM64
.global func_asm
.text
t/025_affix_wrap.t view on Meta::CPAN
use Capture::Tiny qw[capture];
$|++;
# Determine if Clang is available
my $CLANG_AVAIL = do {
my ( undef, undef, $exit ) = capture { system 'clang', '--version' };
$exit == 0;
};
sub spew_files ( $dir, %files ) {
$dir->child($_)->spew_utf8( $files{$_} ) for keys %files;
$dir;
}
sub run_tests_for_driver ( $driver_class, $label ) {
subtest 'Driver: ' . $label => sub {
subtest 'Preprocessor & Defines' => sub {
my $dir = Path::Tiny->tempdir;
spew_files(
$dir,
'defs.h' => <<'EOF',
t/025_affix_wrap.t view on Meta::CPAN
typedef struct { int x; } StaticStruct;
int static_func(int i);
EOF
'main.c' => '#include "static.h"'
);
my $parser = $driver_class->new( project_files => [ $dir->child('static.h')->stringify ] );
my $binder = Affix::Wrap->new( driver => $parser );
my $pm_file = $dir->child('StaticLib.pm');
$binder->generate( 'dummy_lib', 'StaticLib', $pm_file->stringify );
ok -e $pm_file, 'Generated .pm file';
my $content = $pm_file->slurp_utf8;
like $content, qr/package\s+StaticLib\s*{/, 'Package decl';
like $content, qr/use constant STATIC_VAL => 42;/, 'Constant generated';
like $content, qr/typedef StaticStruct => Struct\[ x => Int \];/, 'Struct typedef generated';
like $content, qr/affix \$lib, ('static_func'|\[_static_func => 'static_func'\]) => \[Int\], Int;/, 'Function affix generated';
# Syntax check
my ( undef, undef, $exit ) = capture { system $^X, '-Ilib', '-c', $pm_file->stringify };
is $exit >> 8, 0, 'Generated code syntax check OK';
};
subtest 'Security: _generate_code injection prevention (C1)' => sub {
t/025_affix_wrap.t view on Meta::CPAN
my $parser = $driver_class->new( project_files => [ $dir->child('simple.h')->stringify ] );
my $binder = Affix::Wrap->new( driver => $parser );
# Malicious $lib containing ] must not break q[...] quoting
subtest 'Malicious lib with ]' => sub {
my $evil_lib = 'lib]; system("echo PWNED"); #';
my $pm_file = $dir->child('evil_lib.pm');
lives { $binder->generate( $evil_lib, 'Safe::Lib', $pm_file->stringify ) }
or bail_out 'generate() died on malicious lib';
ok -e $pm_file, 'Generated .pm file despite malicious lib';
my $content = $pm_file->slurp_utf8;
# Package declaration must be clean
like $content, qr/package\s+Safe::Lib\s*\{/, 'Package declaration is safe';
# The ] in the payload must be escaped inside q[...] so it doesn't break out
like $content, qr/q\[.*\\\].*\]/, 'Closing bracket escaped inside q[...]';
# The entire file must compile — proves the payload is inert
my ( undef, undef, $exit ) = capture { system $^X, '-Ilib', '-c', $pm_file->stringify };
is $exit >> 8, 0, 'Generated code compiles despite malicious lib';
t/025_affix_wrap.t view on Meta::CPAN
[ 'Good', 'simple name' ],
[ 'GoodName', 'single word' ],
[ 'Test123', 'alphanumeric' ],
[ '_private', 'leading underscore' ],
);
for my $t (@good_pkgs) {
my ( $good_pkg, $desc ) = @$t;
my $pm_file = $dir->child("good_$good_pkg.pm");
lives { $binder->generate( 'good_lib', $good_pkg, $pm_file->stringify ) }
or fail "Should accept $desc: $good_pkg";
like $pm_file->slurp_utf8, qr/package\s+\Q$good_pkg\E\s*\{/, "Package decl for $desc";
}
# Names with :: are valid Perl packages but can't be tested via
# file I/O on Windows (colon is forbidden in filenames). Verify
# they pass validation without writing to disk.
my @ns_pkgs = ( 'Good::Name', 'A::B::C::D' );
for my $good_pkg (@ns_pkgs) {
my $code = eval {
my ( $c, $n ) = $binder->_generate_code( 'good_lib', $good_pkg );
$c;
t/025_affix_wrap.t view on Meta::CPAN
ok dies { $binder->generate( 'lib', $bad, '/dev/null' ) }, "rejects $desc: $bad";
}
};
# $lib with backslashes (Windows paths) must be handled
subtest 'Windows-style lib paths' => sub {
my $win_lib = 'C:\Users\Test\lib.dll';
my $pm_file = $dir->child('winpath.pm');
lives { $binder->generate( $win_lib, 'WinPathTest', $pm_file->stringify ) }
or bail_out 'generate() died on Windows path';
my $content = $pm_file->slurp_utf8;
# Backslashes are doubled when escaped for q[...] (\\ -> \\\\)
like $content, qr/q\[.*C:\\\\Users\\\\Test\\\\lib\.dll\]/, 'Windows path safely quoted';
my ( undef, undef, $exit ) = capture { system $^X, '-Ilib', '-c', $pm_file->stringify };
is $exit >> 8, 0, 'Generated code compiles with Windows path';
};
# wrap() must also reject bad $pkg
subtest 'wrap() rejects malicious pkg' => sub {
ok dies { $binder->wrap( 'good_lib', 'Evil; system("echo PWNED")' ) }, 'wrap() rejects malicious pkg name';
t/077_unicode.t view on Meta::CPAN
is $len->(""), 0, 'strlen correct for empty string';
};
#
subtest 'UTF-8 byte roundtrip' => sub {
my $echo = wrap( $lib, 'echo_str', [String], String );
my $len = wrap( $lib, 'str_len', [String], Int32 );
# Affix passes strings as raw bytes through FFI
# 2-byte UTF-8: é (U+00E9) = 0xC3 0xA9
my $two_byte = "café";
utf8::encode($two_byte);
my $got = $echo->($two_byte);
is $got, $two_byte, '2-byte UTF-8 bytes roundtrip';
# 3-byte UTF-8: ä¸å›½ (U+4E2D U+56FD)
my $three_byte = "ä¸å›½";
utf8::encode($three_byte);
$got = $echo->($three_byte);
is $got, $three_byte, '3-byte UTF-8 bytes roundtrip';
# Mixed ASCII and multibyte
my $mixed = "Hello 世界";
utf8::encode($mixed);
$got = $echo->($mixed);
is $got, $mixed, 'Mixed ASCII + multibyte bytes roundtrip';
# Verify byte lengths (strlen counts bytes, not characters)
is $len->($two_byte), length($two_byte), 'byte length correct for 2-byte UTF-8';
is $len->($three_byte), length($three_byte), 'byte length correct for 3-byte UTF-8';
};
#
subtest 'Empty string roundtrip' => sub {
my $echo = wrap( $lib, 'echo_str', [String], String );
is $echo->(""), "", 'Empty string roundtrip';
};
#
subtest 'String encoding roundtrip via encode/decode' => sub {
my $echo = wrap( $lib, 'echo_str', [String], String );
# Encode Perl string to UTF-8 bytes, pass through C, decode back
my $input = "café ä¸å›½ 🎉";
utf8::encode($input);
my $output = $echo->($input);
utf8::decode($output);
is $output, "café ä¸å›½ 🎉", 'Full encode/C/decode roundtrip preserves Unicode';
};
#
subtest 'str_len counts bytes not characters' => sub {
my $len = wrap( $lib, 'str_len', [String], Int32 );
my $str = "café";
utf8::encode($str);
is $len->($str), 5, 'café has 5 bytes (2+1+1+1), not 4 characters';
$str = "ä¸å›½";
utf8::encode($str);
is $len->($str), 6, 'ä¸å›½ has 6 bytes (3+3), not 2 characters';
};
done_testing;
t/086_wstring_struct.t view on Meta::CPAN
use v5.40;
use utf8;
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
use Config;
# wchar_t is 2 bytes (UTF-16) on Windows and 4 bytes (UTF-32) on most Unices.
my $wchar_sz = sizeof(WChar); #$Config{wcharsize} // ( $^O eq 'MSWin32' ? 2 : 4 );
#
my $lib = compile_ok(<<~'');
( run in 1.086 second using v1.01-cache-2.11-cpan-ad19def0cd9 )