Affix
view release on metacpan or search on metacpan
use v5.40;
use lib 'builder';
use Affix::Builder;
Affix::Builder->new->Build_PL();
Affix - A Foreign Function Interface eXtension
# SYNOPSIS
```perl
use v5.40;
use Affix qw[:all];
# Bind a function and call it natively.
# Here, we use libm which might be in libm.so, msvcrt.dll, etc.
# C: double pow(double x, double y);
affix libm(), 'pow', [ Double, Double ] => Double;
say pow( 2.0, 10.0 ); # 1024
# Working with C structs is easy
# C: typedef struct { int x; int y; } Point;
# void draw_point(Point p);
typedef Point => Struct[ x => Int, y => Int ];
affix $lib, 'draw_point', [ Point() ] => Void;
draw_point( { x => 10, y => 20 } );
builder/Affix/Builder.pm view on Meta::CPAN
my $method = $self->can( 'step_' . $action );
$method // die "No such action '$action'\n";
exit $method->( $self, @args );
}
method Build_PL() {
die "Pure perl Affix? Ha! You wish.\n" if $pureperl;
say sprintf 'Creating new Build script for %s %s', $meta->name, $meta->version;
$self->write_file( 'Build', sprintf <<'', $^X, __PACKAGE__, __PACKAGE__ );
#!%s
use lib 'builder';
use %s;
my $action = @ARGV && $ARGV[0] =~ /\A\w+\z/ ? shift @ARGV : 'build';
my $opts = {};
while ( @ARGV ) {
my $a = shift @ARGV;
if ( $a =~ /^-(\w+)$/ ) { $opts->{$1} = shift @ARGV // 1; }
elsif ( $a =~ /^-(\w+)=(.+)$/ ) { $opts->{$1} = $2; }
}
%s->new( action => $action )->Build( %%$opts );
lib/Affix.pod view on Meta::CPAN
=head1 NAME
Affix - A Foreign Function Interface eXtension
=head1 SYNOPSIS
use v5.40;
use Affix qw[:all];
# Bind a function and call it natively.
# Here, we use libm which might be in libm.so, msvcrt.dll, etc.
# C: double pow(double x, double y);
affix libm(), 'pow', [ Double, Double ] => Double;
say pow( 2.0, 10.0 ); # 1024
# Working with C structs is easy
# C: typedef struct { int x; int y; } Point;
# void draw_point(Point p);
typedef Point => Struct[ x => Int, y => Int ];
affix $lib, 'draw_point', [ Point() ] => Void;
draw_point( { x => 10, y => 20 } );
lib/Test2/Tools/Affix.pm view on Meta::CPAN
);
plan skip_all 'Valgrind is not installed' if $exit_code;
diag 'Valgrind v', ( $stdout =~ m/valgrind-(.+)$/ ), ' found';
diag 'Generating suppressions...';
my @cmd = (
qw[valgrind --leak-check=full --show-reachable=yes --error-limit=no
--gen-suppressions=all --log-fd=1], $^X, '-e',
sprintf <<'', ( join ', ', map {"'$_'"} sort { length $a <=> length $b } map { path($_)->absolute->canonpath } @INC ) );
use strict;
use warnings;
use lib %s;
use Affix;
no Test2::Plugin::ExitSummary;
use Test2::V0;
pass "generate valgrind suppressions";
done_testing;
#~ use Data::Dump;
#~ ddx \@cmd;
my ( $out, $err, @res ) = Capture::Tiny::capture(
lib/Test2/Tools/Affix.pm view on Meta::CPAN
# Function to run anonymous sub in a new process with valgrind
sub leaks( $name, $code_ref ) {
init_valgrind();
#
require B::Deparse;
CORE::state $deparse //= B::Deparse->new(qw[-l]);
my ( $package, $file, $line ) = caller;
my $source = sprintf
<<'', ( join ', ', map {"'$_'"} sort { length $a <=> length $b } grep {defined} map { my $dir = path($_); $dir->exists ? $dir->absolute->realpath : () } @INC, 't/lib' ), Test2::API::test2_stack()->top->{count}, $deparse->coderef2text(...
use lib %s;
use Test2::V0 -no_srand => 1, '!subtest';
use Test2::Util::Importer 'Test2::Tools::Subtest' => ( subtest_streamed => { -as => 'subtest' } );
use Test2::Plugin::UTF8;
no Test2::Plugin::ExitSummary; # I wish
use Test2::Tools::Affix;
# Test2::API::test2_stack()->top->{count} = %d;
$|++;
my $exit = sub {use Affix; Affix::set_destruct_level(3); %s;}->();
# Test2::API::test2_stack()->top->{count}++;
done_testing;
t/001_affix.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
subtest import => sub {
imported_ok qw[affix wrap];
imported_ok qw[libm libc];
t/002_synopsis.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
ok my $libm = libm(), 'my $libm = libm()';
ok affix( $libm, 'pow', [ Double, Double ] => Double ), q[affix $libm, 'pow', [Double, Double] => Double];
is pow( 2.0, 10.0 ), 1024, 'pow(2.0, 10.0)';
t/005_varargs.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
my $c_code = <<'END_C';
#include "std.h"
//ext: .c
t/006_out_params.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
my $lib = compile_ok( <<'END_C', { name => 'lvalue param lib' } );
#include "std.h"
//ext: .c
#include <stdlib.h>
t/008_long_double.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
use Config;
#
$|++;
#
my $c_source = <<'END_C';
#include "std.h"
t/009_128bit.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
my $c_source = <<'END_C';
#include "std.h"
//ext: .c
t/010_simd.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
use Config;
#
$|++;
#
my $c_source = <<'END_C';
#include "std.h"
t/011_type_introspection.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
my $size_of_int = sizeof(Int32);
is $size_of_int, 4, 'sizeof(int32)';
#
t/014_array.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0;
use Affix qw[:all];
#
$|++;
#
# This C code will be compiled into a temporary library for many of the tests.
my $C_CODE = <<'END_C';
#include "std.h"
t/015_library.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
# This C code will be compiled into a temporary library for many of the tests.
my $C_CODE = <<'END_C';
#include "std.h"
t/016_union.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
# This C code will be compiled into a temporary library for many of the tests.
my $C_CODE = <<'END_C';
#include "std.h"
t/018_sv_type.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
use Affix::Build;
use Config;
use ExtUtils::Embed;
#
diag '$Config{useshrplib} claims to be ' . $Config{useshrplib};
diag '$Config{libperl} is ' . $Config{libperl};
t/019_fileio.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Path::Tiny qw[path tempfile tempdir];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
$|++;
#
subtest simple => sub {
my $lib = compile_ok(<<'END_C');
#include "std.h"
t/021_shakedown.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
my $c_source = <<'END_C';
#include "std.h"
//ext: .c
#include <stdint.h>
t/022_stringlist.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
$|++;
my $C_CODE = <<'END_C';
#include "std.h"
//ext: .c
#include <string.h>
t/023_sockaddr.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
BEGIN {
unless ( eval { require Socket; Socket->import(qw[:all]); 1 } ) {
print "1..0 # SKIP Socket module required\n";
exit 0;
}
t/024_buffer.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
$|++;
#
my $lib = compile_ok(<<~'');
#include "std.h"
//ext: .c
t/027_thread_safety.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
use Config;
#
$|++;
#
subtest 'os threads' => sub {
typedef Callback_t => Callback [ [Int] => Void ];
t/028_pointer_indexing.t view on Meta::CPAN
use v5.40;
use lib 'lib', 'blib/arch', 'blib/lib';
use blib;
use Affix qw[:all];
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
#
my $ptr = cast( calloc( 4, sizeof sizeof( Array [ Int, 4 ] ) ), Array [ Int, 4 ] );
# Test FETCH
is $ptr->[0], 0, 'FETCH index 0';
is $ptr->[3], 0, 'FETCH index 3';
t/040_error.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix;
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
# We need a function that is guaranteed to fail and set errno/GetLastError.
# 'remove' (unlink) on a non-existent file is a classic choice.
my $remove = wrap libc, 'remove', [String] => Int;
my $missing_file = 'non_existent_file_' . int( rand 100000 ) . '.txt';
t/092_struct_signature_layout.t view on Meta::CPAN
use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Affix qw[:all];
#
# Regression test for struct member layout when a struct type is declared
# inline in a function signature (as opposed to a typedef-registered type).
#
# Structs inside function signatures used to keep the offsets computed at
# parse time, while their members were still unresolved named types (size 0).
t/094_cast_cycle.t view on Meta::CPAN
use lib './lib', '../lib', '../blib/arch/', 'blib/arch', '../', '.';
use Affix qw[:all];
use Test2::V0 -no_srand => 1;
use v5.36;
# Regression test for the pin-tree refcount cycle that leaked memory on every
# Affix::cast() of an aggregate. The rope.pl SDL3 demo grows ~5.4KB/iter
# whenever a mouse-move event is polled (every event runs Affix::cast()):
# the per-cast parse arena (4096B) plus ~290B per struct member was never
# reclaimed because member pins strongly referenced the freshly created parent
# HV/AV, forming an uncollectable cycle. Member pins now borrow the external
t/095_union_sync.t view on Meta::CPAN
use lib './lib', '../lib', '../blib/arch/', 'blib/arch', '../', '.';
use Affix qw[:all];
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use v5.36;
# Regression test for the segfault syncing a union whose members overlap a
# String/pointer field with float data. The rope.pl SDL3 demo crashed when an
# SDL_Event (a union) had `motion.x/y` written and was then passed to
# SDL_PushEvent(): the argument sync (lazy_agg_set) read back *every* union
# member, and reading the inactive `drop.file` (Pointer[String]) dereferenced
t/900_leak.t view on Meta::CPAN
use lib './lib', '../lib', '../blib/arch/', 'blib/arch', '../', '.';
use Affix qw[:all];
use Test2::Tools::Affix qw[:all];
use Test2::V0 -no_srand => 1;
use Test2::Require::AuthorTesting;
$|++;
skip_all 'I have no idea why *BSD is leaking here' if $^O =~ /BSD/i;
leaks 'use Affix' => sub {
use Affix qw[];
pass 'loaded';
};
( run in 1.670 second using v1.01-cache-2.11-cpan-aadc1410aed )