allow building with high-water mark to be independent of -DDEBUGGING

This allows a debugging perl to be built with the high water mark checks disabled, or a non-debugging perl to be built with the high water marks enabled. This should allow Debian, the reporter for #16607 to build both their normal perl and debugperl with the same state of high water mark checks and avoid the mismatch between a debugperl and non-debug dynamic extension. Fixes #16607
2026-01-26 08:38:23 +00:00 · 2024-04-09 15:53:30 +10:00 · 2024-04-09 15:53:30 +10:00 · a742fa0e61
commit a742fa0e61
parent a33729fe99
12 changed files with 65 additions and 16 deletions
--- a/cop.h
+++ b/cop.h
@ -44,7 +44,7 @@ MSVC_DIAG_RESTORE

 typedef struct jmpenv JMPENV;

-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#if defined PERL_USE_HWM
 #  define JE_OLD_STACK_HWM_zero      PL_start_env.je_old_stack_hwm = 0
 #  define JE_OLD_STACK_HWM_save(je)  \
        (je).je_old_stack_hwm = PL_curstackinfo->si_stack_hwm
@ -1271,7 +1271,7 @@ struct stackinfo {
    I32                 si_stack_nonrc_base;
 #endif

-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
 /* high water mark: for checking if the stack was correctly extended /
 * tested for extension by each pp function */
    SSize_t             si_stack_hwm;
@ -1298,7 +1298,7 @@ typedef struct stackinfo PERL_SI;
 #  define SET_MARK_OFFSET NOOP
 #endif

-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
 #  define PUSHSTACK_INIT_HWM(si) ((si)->si_stack_hwm = 0)
 #else
 #  define PUSHSTACK_INIT_HWM(si) NOOP
--- a/dump.c
+++ b/dump.c
@ -2808,7 +2808,7 @@ Perl_hv_dump(pTHX_ HV *hv)
 int
 Perl_runops_debug(pTHX)
 {
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
    SSize_t orig_stack_hwm = PL_curstackinfo->si_stack_hwm;

    PL_curstackinfo->si_stack_hwm = PL_stack_sp - PL_stack_base;
@ -2829,7 +2829,7 @@ Perl_runops_debug(pTHX)
 #ifdef PERL_TRACE_OPS
        ++PL_op_exec_cnt[PL_op->op_type];
 #endif
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
        if (PL_curstackinfo->si_stack_hwm < PL_stack_sp - PL_stack_base)
            Perl_croak_nocontext(
                "panic: previous op failed to extend arg stack: "
@ -2867,7 +2867,7 @@ Perl_runops_debug(pTHX)
    DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
    PERL_ASYNC_CHECK();

-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
    if (PL_curstackinfo->si_stack_hwm < orig_stack_hwm)
        PL_curstackinfo->si_stack_hwm = orig_stack_hwm;
 #endif
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Carp;

-our $VERSION = '1.35';
+our $VERSION = '1.36';

 require XSLoader;

--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@ -1601,6 +1601,12 @@ destruct_test(pTHX_ void *p) {
    warn("In destruct_test: %" SVf "\n", (SV*)p);
 }

+#ifdef PERL_USE_HWM
+#  define hwm_checks_enabled() true
+#else
+#  define hwm_checks_enabled() false
+#endif
+
 MODULE = XS::APItest            PACKAGE = XS::APItest

 INCLUDE: const-xs.inc
@ -2670,6 +2676,17 @@ PPCODE:
        *PL_stack_max = NULL;


+void
+bad_EXTEND()
+    PPCODE:
+        /* testing failure to extend the stack, do not extend the stack */
+        PUSHs(&PL_sv_yes);
+        PUSHs(&PL_sv_no);
+        XSRETURN(2);
+
+bool
+hwm_checks_enabled()
+
 void
 call_sv_C()
 PREINIT:
--- a/ext/XS-APItest/t/extend.t
+++ b/ext/XS-APItest/t/extend.t
@ -13,9 +13,9 @@

 use Test::More;
 use Config;
-use XS::APItest qw(test_EXTEND);
+use XS::APItest qw(test_EXTEND hwm_checks_enabled bad_EXTEND);

-plan tests => 48;
+plan tests => 50;

 my $uvsize   = $Config::Config{uvsize};   # sizeof(UV)
 my $sizesize = $Config::Config{sizesize}; # sizeof(Size_t)
@ -66,3 +66,15 @@ for my $offset (-1, 0, 1) {
        }
    }
 }
+
+SKIP:
+{
+    # we've extended the stack a fair bit above so the actual bad_EXTEND*() should
+    # be safe in terms of UB *here*
+    skip "HWM checks not enabled", 2
+      unless hwm_checks_enabled();
+
+    ok(!eval { bad_EXTEND(); 1 }, "bad_EXTEND() should throw");
+    like($@, qr/^panic: XSUB XS::APItest::bad_EXTEND \(APItest\.c\) failed to extend arg stack/,
+         "check panic message");
+}
--- a/op.c
+++ b/op.c
@ -5146,7 +5146,7 @@ S_gen_constant_list(pTHX_ OP *o)

    switch (ret) {
    case 0:
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
        PL_curstackinfo->si_stack_hwm = 0; /* stop valgrind complaining */
 #endif
        Perl_pp_pushmark(aTHX);
--- a/perl.c
+++ b/perl.c
@ -4514,7 +4514,7 @@ Perl_init_stacks(pTHX)
                                 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1),
                                 make_real);
    PL_curstackinfo->si_type = PERLSI_MAIN;
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
    PL_curstackinfo->si_stack_hwm = 0;
 #endif
    PL_curstack = PL_curstackinfo->si_stack;
--- a/perl.h
+++ b/perl.h
@ -1087,6 +1087,26 @@ violations are fatal.
 */
 #define PERL_USE_SAFE_PUTENV

+/* Control whether we set and test the stack high water mark.
+ *
+ * When enabled this checks that pp funcs and XSUBs properly EXTEND()
+ * the stack.
+ *
+ * Debugging builds have HWM checks on by default, you can add
+ * -DPERL_NO_HWM to ccflags to prevent those checks, or add
+ * -DPERL_USE_HWM to ccflags to perform HWM checks even on
+ * non-debugging builds.
+ */
+
+#if defined PERL_NO_HWM
+#  undef PERL_USE_HWM
+#elif defined PERL_USE_HWM
+/* nothing to do here */
+#elif defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#  define PERL_USE_HWM
+#endif
+
+
 /* HP-UX 10.X CMA (Common Multithreaded Architecture) insists that
   pthread.h must be included before all other header files.
 */
@ -5204,7 +5224,7 @@ typedef Sighandler_t Sigsave_t;
 #define SCAN_TR 1
 #define SCAN_REPL 2

-#ifdef DEBUGGING
+#if defined DEBUGGING || defined PERL_USE_HWM
 # ifndef register
 #  define register
 # endif
--- a/pp.h
+++ b/pp.h
@ -387,7 +387,7 @@ Does not use C<TARG>.  See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>.
 /* EXTEND_HWM_SET: note the high-water-mark to which the stack has been
 * requested to be extended (which is likely to be less than PL_stack_max)
 */
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
 #  define EXTEND_HWM_SET(p, n)                                     \
        STMT_START {                                               \
            SSize_t extend_hwm_set_ix = (p) - PL_stack_base + (n); \
--- a/pp_hot.c
+++ b/pp_hot.c
@ -6494,7 +6494,7 @@ PP(pp_entersub)

        rpp_invoke_xs(cv);

-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
        /* This duplicates the check done in runops_debug(), but provides more
         * information in the common case of the fault being with an XSUB.
         *
--- a/scope.c
+++ b/scope.c
@ -56,7 +56,7 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
        Perl_croak(aTHX_ "Out of memory during stack extend");

    av_extend(PL_curstack, current + n + extra);
-#ifdef DEBUGGING
+#ifdef PERL_USE_HWM
        PL_curstackinfo->si_stack_hwm = current + n + extra;
 #endif

--- a/sv.c
+++ b/sv.c
@ -15159,7 +15159,7 @@ Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
 #ifdef PERL_RC_STACK
    nsi->si_stack_nonrc_base = si->si_stack_nonrc_base;
 #endif
-#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+#ifdef PERL_USE_HWM
    nsi->si_stack_hwm   = 0;
 #endif