ext/XS-APItest/t/cv_name.t test cv_name
ext/XS-APItest/t/eval-filter.t Simple source filter/eval test
ext/XS-APItest/t/exception.t XS::APItest extension
+ext/XS-APItest/t/extend.t test EXTEND() macro
ext/XS-APItest/t/fetch_pad_names.t Tests for UTF8 names in pad
ext/XS-APItest/t/gotosub.t XS::APItest: tests goto &xsub and hints
ext/XS-APItest/t/grok.t XS::APItest: tests for grok* functions
{
PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
+ if (key < -1) /* -1 is legal */
+ Perl_croak(aTHX_
+ "panic: av_extend_guts() negative count (%"IVdf")", (IV)key);
+
if (key > *maxp) {
SV** ary;
SSize_t tmp;
mXPUSHu(3);
XSRETURN(3);
+
+ # test_EXTEND(): excerise the EXTEND() macro.
+ # After calling EXTEND(), it also does *(p+n) = NULL and
+ # *PL_stack_max = NULL to allow valgrind etc to spot if the stack hasn't
+ # actually been extended properly.
+ #
+ # max_offset specifies the SP to use. It is treated as a signed offset
+ # from PL_stack_max.
+ # nsv is the SV holding the value of n indicating how many slots
+ # to extend the stack by.
+ # use_ss is a boolean indicating that n should be cast to a SSize_t
+
+void
+test_EXTEND(max_offset, nsv, use_ss)
+ IV max_offset;
+ SV *nsv;
+ bool use_ss;
+PREINIT:
+ SV **sp = PL_stack_max + max_offset;
+PPCODE:
+ if (use_ss) {
+ SSize_t n = (SSize_t)SvIV(nsv);
+ EXTEND(sp, n);
+ *(sp + n) = NULL;
+ }
+ else {
+ IV n = SvIV(nsv);
+ EXTEND(sp, n);
+ *(sp + n) = NULL;
+ }
+ *PL_stack_max = NULL;
+
+
void
call_sv_C()
PREINIT:
--- /dev/null
+#!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)";
+
+
+ }
+ }
+}
=cut
*/
+/* _EXTEND_SAFE_N(n): private helper macro for EXTEND().
+ * Tests whether the value of n would be truncated when implicitly cast to
+ * SSize_t as an arg to stack_grow(). If so, sets it to -1 instead to
+ * trigger a panic. It will be constant folded on platforms where this
+ * can't happen.
+ */
+
+#define _EXTEND_SAFE_N(n) \
+ (sizeof(n) > sizeof(SSize_t) && ((SSize_t)(n) != (n)) ? -1 : (n))
+
#ifdef STRESS_REALLOC
# define EXTEND(p,n) STMT_START { \
- sp = stack_grow(sp,p,(SSize_t) (n)); \
+ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
PERL_UNUSED_VAR(sp); \
} STMT_END
/* Same thing, but update mark register too. */
# define MEXTEND(p,n) STMT_START { \
const SSize_t markoff = mark - PL_stack_base; \
- sp = stack_grow(sp,p,(SSize_t) (n)); \
+ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
mark = PL_stack_base + markoff; \
PERL_UNUSED_VAR(sp); \
} STMT_END
#else
-# define EXTEND(p,n) STMT_START { \
- if (UNLIKELY(PL_stack_max - p < (SSize_t)(n))) { \
- sp = stack_grow(sp,p,(SSize_t) (n)); \
+
+/* _EXTEND_NEEDS_GROW(p,n): private helper macro for EXTEND().
+ * Tests to see whether n is too big and we need to grow the stack. Be
+ * very careful if modifying this. There are many ways to get things wrong
+ * (wrapping, truncating etc) that could cause a false negative and cause
+ * the call to stack_grow() to be skipped. On the other hand, false
+ * positives are safe.
+ * Bear in mind that sizeof(p) may be less than, equal to, or greater
+ * than sizeof(n), and while n is documented to be signed, someone might
+ * pass an unsigned value or expression. In general don't use casts to
+ * avoid warnings; instead expect the caller to fix their code.
+ * It is legal for p to be greater than PL_stack_max.
+ * If the allocated stack is already very large but current usage is
+ * small, then PL_stack_max - p might wrap round to a negative value, but
+ * this just gives a safe false positive
+ */
+
+# define _EXTEND_NEEDS_GROW(p,n) ( (n) < 0 || PL_stack_max - p < (n))
+
+# define EXTEND(p,n) STMT_START { \
+ if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \
+ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
PERL_UNUSED_VAR(sp); \
} } STMT_END
/* Same thing, but update mark register too. */
-# define MEXTEND(p,n) STMT_START { \
- if (UNLIKELY(PL_stack_max - p < (SSize_t)(n))) { \
- const SSize_t markoff = mark - PL_stack_base; \
- sp = stack_grow(sp,p,(SSize_t) (n)); \
+# define MEXTEND(p,n) STMT_START { \
+ if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \
+ const SSize_t markoff = mark - PL_stack_base;\
+ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
mark = PL_stack_base + markoff; \
PERL_UNUSED_VAR(sp); \
} } STMT_END
}
av_clear(ary);
- av_extend(ary, lastrelem - relem);
+ if (relem <= lastrelem)
+ av_extend(ary, lastrelem - relem);
+
i = 0;
while (relem <= lastrelem) { /* gobble up all the rest */
SV **didstore;
{
PERL_ARGS_ASSERT_STACK_GROW;
+ if (n < 0)
+ Perl_croak(aTHX_
+ "panic: stack_grow() negative count (%"IVdf")", (IV)n);
+
PL_stack_sp = sp;
#ifndef STRESS_REALLOC
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);