view release on metacpan or  search on metacpan

t/025_affix_wrap.t  view on Meta::CPAN

use v5.40;
use Affix::Wrap;
use Test2::Tools::Affix qw[:all];
use Path::Tiny;
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',
/** @brief Buffer Size */
#define BUF_SIZE 1024
#define API_NAME "MyLib"
#define CALC_VAL (10 + 20)
#define FLAG_A 1
#define FLAG_B 2
#define FLAGS_AB (FLAG_A | FLAG_B)
EOF
                'main.c' => '#include "defs.h"'
            );
            my $parser = $driver_class->new( project_files => [ $dir->child('defs.h')->stringify ] );
            my @objs   = $parser->parse( $dir->child('main.c')->stringify, [ $dir->stringify ] );
            my ($buf)  = grep { $_->name eq 'BUF_SIZE' } @objs;
            ok( $buf, 'Found BUF_SIZE' );
            is( $buf->value, '1024', 'BUF_SIZE value' );
            like( $buf->doc, qr/Buffer Size/, 'BUF_SIZE doc' );
            my ($calc) = grep { $_->name eq 'CALC_VAL' } @objs;
            ok( $calc, 'Found CALC_VAL' );

            # affix_type should quote expressions: '(10 + 20)' -> "'(10 + 20)'" or similar
            like( $calc->affix_type, qr/'?\(10 \+ 20\)'?/, 'Expression quoted in affix_type' );

            # Test bitwise OR resolution in wrap()
            my $wrap   = Affix::Wrap->new( driver => $parser );
            my $target = "Test::Macro::" . $label;
            $target =~ s/\W+/_/g;
            $wrap->wrap( undef, $target );
            is( $target->can('FLAGS_AB')->(), 3, 'FLAGS_AB resolved to 3' );
        };
        subtest 'Records (Structs & Unions)' => sub {
            my $dir = Path::Tiny->tempdir;
            spew_files(
                $dir,
                'structs.h' => <<'EOF',
/** @brief A Point */
typedef struct {
    int x;
    int y;
} Point;

typedef struct {
    int id;
    union {
        int i;
        float f;
    } payload;
} Packet;
EOF
                'main.c' => '#include "structs.h"'
            );
            my $parser = $driver_class->new( project_files => [ $dir->child('structs.h')->stringify ] );
            my @objs   = $parser->parse( $dir->child('main.c')->stringify, [ $dir->stringify ] );

            # Check Point (Expect Typedef -> Struct)
            my ($pt_td) = grep { $_->name eq 'Point' && $_->isa('Affix::Wrap::Typedef') } @objs;
            ok( $pt_td, 'Found Point Typedef' );
            my $pt = $pt_td->underlying;
            isa_ok( $pt, ['Affix::Wrap::Struct'], 'Underlying is Struct' );
            like( $pt_td->doc, qr/A Point/, 'Point doc found on typedef' );
            is( $pt->members->[0]->name,             'x',   'Member x name' );
            is( $pt->members->[0]->type->affix_type, 'Int', 'Member x is Int' );

            # Check Packet
            my ($pkt_td) = grep { $_->name eq 'Packet' } @objs;
            my $pkt = $pkt_td->underlying;
            ok( $pkt, 'Found Packet Struct' );
            is( $pkt->members->[0]->name, 'id',      'Member 0: id' );
            is( $pkt->members->[1]->name, 'payload', 'Member 1: payload' );

            # Check Nested Union
            my $u_mem = $pkt->members->[1];

            # The member type is technically empty/void in C AST often, but it has a definition
            ok( $u_mem->definition, 'Payload has definition' );
            my $u = $u_mem->definition;
            if ($u) {
                is( $u->tag,                            'union', 'Payload is union tag' );
                is( $u->members->[0]->name,             'i',     'Union mem 0: i' );
                is( $u->members->[1]->type->affix_type, 'Float', 'Union mem 1 is Float' );
                like( $u->affix_type, qr/^Union\[/, 'Generates Union[...] signature' );
            }
        };
        subtest Enums => sub {
            my $dir = Path::Tiny->tempdir;
            spew_files(