view release on metacpan or  search on metacpan

t/000_compile.t  view on Meta::CPAN

use v5.40;
use Test2::V0 '!subtest';
use Test2::Util::Importer 'Test2::Tools::Subtest' => ( subtest_streamed => { -as => 'subtest' } );
use lib 'lib', '../lib', 'blib/lib', '../blib/lib';
use SDL3 qw[:all];
#
ok $SDL3::VERSION, 'SDL3::VERSION: ' . $SDL3::VERSION;
subtest ':hints' => sub {
    imported_ok qw[SDL_SetHint SDL_GetHint SDL_HINT_VIDEO_DRIVER];
    diag 'Force the dummy driver so this runs on servers/CI without displays';

    # This is important for many of the following tests.
    ok SDL_SetHint( SDL_HINT_VIDEO_DRIVER, 'dummy' ), 'Set video driver to dummy';
    is SDL_GetHint(SDL_HINT_VIDEO_DRIVER), 'dummy', 'Verified video driver hint';
};
subtest ':init' => sub {
    imported_ok qw[SDL_Init SDL_Quit SDL_WasInit SDL_INIT_VIDEO SDL_INIT_EVENTS];

    # Initialize video (which implies events)
    ok SDL_Init( SDL_INIT_VIDEO | SDL_INIT_EVENTS ), 'SDL_Init(VIDEO | EVENTS)';
    is SDL_WasInit(SDL_INIT_VIDEO), SDL_INIT_VIDEO, 'SDL_WasInit confirms VIDEO is initialized';
};
subtest ':clipboard' => sub {    # This must come after SDL_Init...
    imported_ok qw[SDL_SetClipboardText SDL_GetClipboardText];
    ok SDL_SetClipboardText('Perl SDL3 Rocks'), 'Set clipboard text';

    # On some strict headless CI (like minimal docker containers),
    # clipboard internal operations might fail or return empty strings.
    # We check if the call didn't crash, but getting the value back depends on OS support.
    my $txt = SDL_GetClipboardText();
    diag "Clipboard contains: " . ( $txt // '<undef>' );
};
subtest ':error' => sub {
    imported_ok qw[SDL_SetError SDL_GetError SDL_ClearError];
    is SDL_SetError('Test Error'), F(),          'SDL_SetError(...)';
    is SDL_GetError(),             'Test Error', 'SDL_SetError set the message correctly';
    SDL_ClearError();
    is SDL_GetError(), "", 'SDL_ClearError cleared message';
};
subtest ':stdinc' => sub {
    imported_ok qw[SDL_malloc SDL_free SDL_strcmp SDL_strlen SDL_memcpy];

    # Test Memory Allocation
    my $ptr = SDL_malloc(1024);
    ok $ptr, 'SDL_malloc allocated memory';
    SDL_free($ptr);
    pass 'SDL_free executed';

    # Test Strings
    is SDL_strlen('Hello'),          5, 'SDL_strlen calculations correct';
    is SDL_strcmp( 'foo', 'foo' ),   0, 'SDL_strcmp match';
    isnt SDL_strcmp( 'foo', 'bar' ), 0, 'SDL_strcmp mismatch';
};
subtest ':rect' => sub {
    imported_ok qw[SDL_HasRectIntersection SDL_GetRectUnion];
    my $rect_a = { x => 0,   y => 0,   w => 100, h => 100 };
    my $rect_b = { x => 50,  y => 50,  w => 100, h => 100 };
    my $rect_c = { x => 200, y => 200, w => 10,  h => 10 };
    ok SDL_HasRectIntersection( $rect_a,  $rect_b ), 'Rect A and B intersect';
    ok !SDL_HasRectIntersection( $rect_a, $rect_c ), 'Rect A and C do not intersect';
    my $union = { x => 0, y => 0, w => 0, h => 0 };    # Storage for result
    ok SDL_GetRectUnion( $rect_a, $rect_b, $union ), 'Calculated union';
    is $union->{w}, 150, 'Union width';
    is $union->{h}, 150, 'Union height';
};
subtest ':properties' => sub {
    imported_ok qw[SDL_CreateProperties SDL_SetStringProperty SDL_GetStringProperty SDL_DestroyProperties];
    my $props_id = SDL_CreateProperties();
    ok $props_id,                                        'Created Properties ID: ' . $props_id;
    ok SDL_SetStringProperty( $props_id, 'foo', 'bar' ), 'Set string property';
    is SDL_GetStringProperty( $props_id, 'foo',     'default' ), 'bar',     'Get string property';
    is SDL_GetStringProperty( $props_id, 'missing', 'default' ), 'default', 'Get default for missing property';
    SDL_DestroyProperties($props_id);
};
subtest ':filesystem' => sub {
    imported_ok qw[SDL_GetBasePath SDL_GetPrefPath];
    my $base = SDL_GetBasePath();
    ok $base, 'Base Path: ' . $base;

    # Note: PrefPath creates the directory if it doesn't exist
    my $pref = SDL_GetPrefPath( 'MyOrg', 'MyApp' );
    ok $pref, 'Pref Path: ' . $pref;
};
subtest ':surface' => sub {    # Should be safe for a headless smoker because we use a software renderer
    imported_ok qw[SDL_CreateSurface SDL_FillSurfaceRect SDL_DestroySurface SDL_PIXELFORMAT_RGBA8888];
    #
    my $surf = SDL_CreateSurface( 10, 10, SDL_PIXELFORMAT_RGBA8888 );
    ok $surf, 'Created 10x10 Surface';