1#!perl 2# 3# Test stack expansion macros: EXTEND() etc, especially for edge cases 4# where the count wraps to a native value or gets truncated. 5# 6# Some of these tests aren't really testing; they are however exercising 7# edge cases, which other tools like ASAN may then detect problems with. 8# In particular, test_EXTEND() does *(p+n) = NULL and *PL_stack_max = NULL 9# before returning, to help such tools spot errors. 10# 11# Also, it doesn't test large but legal grow requests; only ridiculously 12# large requests that are guaranteed to wrap. 13 14use Test::More; 15use Config; 16use XS::APItest qw(test_EXTEND); 17 18plan tests => 48; 19 20my $uvsize = $Config::Config{uvsize}; # sizeof(UV) 21my $sizesize = $Config::Config{sizesize}; # sizeof(Size_t) 22 23# The first arg to test_EXTEND() is the SP to use in EXTEND(), treated 24# as an offset from PL_stack_max. So extend(-1, 1, $use_ss) shouldn't 25# call Perl_stack_grow(), while extend(-1, 2, $use_ss) should. 26# Exercise offsets near to PL_stack_max to detect edge cases. 27# Note that having the SP pointer beyond PL_stack_max is legal. 28 29for my $offset (-1, 0, 1) { 30 31 # treat N as either an IV or a SSize_t 32 for my $use_ss (0, 1) { 33 34 # test with N in range -1 .. 3; only the -1 should panic 35 36 eval { test_EXTEND($offset, -1, $use_ss) }; 37 like $@, qr/panic: .*negative count/, "test_EXTEND($offset, -1, $use_ss)"; 38 39 for my $n (0,1,2,3) { 40 eval { test_EXTEND($offset, $n, $use_ss) }; 41 is $@, "", "test_EXTEND($offset, $n, $use_ss)"; 42 } 43 44 # some things can wrap if the int size is greater than the ptr size 45 46 SKIP: { 47 skip "Not small ptrs", 3 if $use_ss || $uvsize <= $sizesize; 48 49 # 0xffff... wraps to -1 50 eval { test_EXTEND($offset, (1 << 8*$sizesize)-1, $use_ss) }; 51 like $@, qr/panic: .*negative count/, 52 "test_EXTEND(-1, SIZE_MAX, $use_ss)"; 53 54 # 0x10000... truncates to zero; 55 # but the wrap-detection code converts it to -1 to force a panic 56 eval { test_EXTEND($offset, 1 << 8*$sizesize, $use_ss) }; 57 like $@, qr/panic: .*negative count/, 58 "test_EXTEND(-1, SIZE_MAX+1, $use_ss)"; 59 60 # 0x1ffff... truncates and then wraps to -1 61 eval { test_EXTEND($offset, (1 << (8*$sizesize+1))-1, $use_ss) }; 62 like $@, qr/panic: .*negative count/, 63 "test_EXTEND(-1, 2*SIZE_MAX-1, $use_ss)"; 64 65 66 } 67 } 68} 69