#!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)"; } } }