The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
#
# Test stack expansion macros: EXTEND() etc, especially for edge cases
# where the count wraps to a native value or gets truncated.
#
# Some of these tests aren't really testing; they are however exercising
# edge cases, which other tools like ASAN may then detect problems with.
# In particular, test_EXTEND() does *(p+n) = NULL and *PL_stack_max = NULL
# before returning, to help such tools spot errors.
#
# Also, it doesn't test large but legal grow requests; only ridiculously
# large requests that are guaranteed to wrap.

use Test::More;
use Config;
use XS::APItest qw(test_EXTEND);

plan tests => 48;

my $uvsize   = $Config::Config{uvsize};   # sizeof(UV)
my $sizesize = $Config::Config{sizesize}; # sizeof(Size_t)

# The first arg to test_EXTEND() is the SP to use in EXTEND(), treated
# as an offset from PL_stack_max. So extend(-1, 1, $use_ss) shouldn't
# call Perl_stack_grow(), while   extend(-1, 2, $use_ss) should.
# Exercise offsets near to PL_stack_max to detect edge cases.
# Note that having the SP pointer beyond PL_stack_max is legal.

for my $offset (-1, 0, 1) {

    # treat N as either an IV or a SSize_t
    for my $use_ss (0, 1) {

        # test with N in range -1 .. 3; only the -1 should panic

        eval { test_EXTEND($offset, -1, $use_ss) };
        like $@, qr/panic: .*negative count/, "test_EXTEND($offset, -1, $use_ss)";

        for my $n (0,1,2,3) {
            eval { test_EXTEND($offset, $n, $use_ss) };
            is $@, "", "test_EXTEND($offset, $n, $use_ss)";
        }

        # some things can wrap if the int size is greater than the ptr size

        SKIP: {
            skip "Not small ptrs", 3 if $use_ss || $uvsize <= $sizesize;

            # 0xffff... wraps to -1
            eval { test_EXTEND($offset, (1 << 8*$sizesize)-1, $use_ss) };
            like $@, qr/panic: .*negative count/,
                        "test_EXTEND(-1, SIZE_MAX, $use_ss)";

            #  0x10000... truncates to zero;
            #  but the wrap-detection code converts it to -1 to force a panic
            eval { test_EXTEND($offset, 1 << 8*$sizesize, $use_ss) };
            like $@, qr/panic: .*negative count/,
                        "test_EXTEND(-1, SIZE_MAX+1, $use_ss)";

            #  0x1ffff... truncates and then wraps to -1
            eval { test_EXTEND($offset, (1 << (8*$sizesize+1))-1, $use_ss) };
            like $@, qr/panic: .*negative count/,
                        "test_EXTEND(-1, 2*SIZE_MAX-1, $use_ss)";


        }
    }
}