regcomp.c: regexp_engine* Perl_current_re_engine(): might do SvIV(NULL) or SvIV(*(SV**)NULL)

[bulk88]

perl5/regcomp.c

Line 396 in d6f09a8

Perl_current_re_engine(pTHX)

I randomly found a multi-eval of a macro bug here, along with very low quality (bloated) "-O1 optimized" machine code here. But I can't fix it myself because there is currently nonsensical/invalid C code here, and IDK enough in this area of core to write a 100% perfect and correct.

If I try to write a fix, my fix will be doing "defensive coding", which means my fix is not 100% perfect, since "defensive coding" means me/any author admits they don't know what the code does, or what all possible PP/XS/C callers scopes can API wise legally do.

regexp_engine const *
Perl_current_re_engine(pTHX)
{
    if (IN_PERL_COMPILETIME) {
        HV * const table = GvHV(PL_hintgv);
        SV **ptr;

        if (!table || !(PL_hints & HINT_LOCALIZE_HH))
            return &PL_core_reg_engine;
        ptr = hv_fetchs(table, "regcomp", false);
        if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr)))
            return &PL_core_reg_engine;
        return INT2PTR(regexp_engine*, SvIV(*ptr));

how is this not going to SEGV inside SvIV(*ptr) if ptr is NULL?
What if ptr != NULL && !SvOK(*ptr)?

    }
    else {
        SV *ptr;
        if (!PL_curcop->cop_hints_hash)
            return &PL_core_reg_engine;
        ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0);
        if ( !(ptr && SvIOK(ptr) && SvIV(ptr)))
            return &PL_core_reg_engine;
        return INT2PTR(regexp_engine*, SvIV(ptr));

how is this not going to SEGV inside SvIV() if ptr is NULL?
What if ptr != NULL && !SvOK(ptr)?

    }
}

The problem C code was added in/git blames to

f8b2cf8

Author: David Mitchell
Date: 8/17/2011 11:41:04 AM
Message: add Perl_current_re_engine() function

Abstract out into a separate function the task of finding the current
in-scope regex engine ($^H{regex}). Currently this task is only done in
one place each for compile- and run-time, but shortly we'll need it in
other places too.

Steps to Reproduce

N/A. Defect is about nonsensical C code that probably is unreachable or can't execute naturally in any production use of the Perl VM.

Expected behavior

minimum 2, upto max 5, that things that must be rewritten to fix this ticket

• Rewrite the IS_LVALUE bool flag in both hv_fetch() statements to the opposite value from currently in blead
• this code is non-compliant with SV GMG and SV AMG getter rules, specifically SvIOK() can not be tested/probed without executing SvGETMAGIC() beforehand
• if seeing
  GMG_on or seeing SV AMG_on or seeing SvPOK_on && SvCUR() == 1 && SvPVX() eq "1"\o
  would be a bug/invalid/bizzare/a "panic", in this function, then this code should just test SvIOK() and then no-func-call deref SvIVX()
• don't dereference pointer (SV*)NULL) or pointer (SV**)NULL) on both branches of an if {}/else {}
• don't execute, twice in a row, the getter function call Perl_sv_2iv_flags that lives inside macro SvIV()

Perl configuration

N/A, I discovered this in my 5.41.13 perl541.dll binary.
The flawed C code blames to a 2011 commit.