Skip to content

Commit

Permalink
don't test non-null args
Browse files Browse the repository at this point in the history
For lots of core functions:

if a function parameter has been declared NN in embed.fnc, don't test for
nullness at the start of the function, i.e. eliminate code like

    if (!foo) ...

On debugging builds the test is redundant, as the PERL_ARGS_ASSERT_FOO
at the start of the function will already have croaked.

On optimised builds, it will skip the check (and so be slightly faster),
but if actually passed a null arg, will now crash with a null-deref SEGV
rather than doing whatever the check used to do (e.g. croak, or silently
return and let the caller's code logic to go awry). But hopefully  this
should never happen as such instances will already have been detected on
debugging builds.

It also has the advantage of shutting up recent clangs which spew forth
lots of stuff like:

    sv.c:6308:10: warning: nonnull parameter 'bigstr' will evaluate to
    'true' on first encounter [-Wpointer-bool-conversion]
        if (!bigstr)

The only exception was in dump.c, where rather than skipping the null
test, I instead changed the function def in embed.fnc to allow a null arg,
on the basis that dump functions are often used for debugging (where
pointers may unexpectedly become NULL) and it's better there to display
that this item is null than to SEGV.

See the p5p thread starting at 20150224112829.GG28599@iabyn.com.
  • Loading branch information
iabyn committed Mar 11, 2015
1 parent 1835335 commit 3dc7863
Show file tree
Hide file tree
Showing 11 changed files with 20 additions and 60 deletions.
3 changes: 0 additions & 3 deletions dump.c
Expand Up @@ -1090,9 +1090,6 @@ Perl_gv_dump(pTHX_ GV *gv)
const char* name;
SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);


PERL_ARGS_ASSERT_GV_DUMP;

if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
return;
Expand Down
4 changes: 2 additions & 2 deletions embed.fnc
Expand Up @@ -445,7 +445,7 @@ Ap |void |dump_all
p |void |dump_all_perl |bool justperl
Ap |void |dump_eval
Ap |void |dump_form |NN const GV* gv
Ap |void |gv_dump |NN GV* gv
Ap |void |gv_dump |NULLOK GV* gv
Ap |void |op_dump |NN const OP *o
Ap |void |pmop_dump |NULLOK PMOP* pm
Ap |void |dump_packsubs |NN const HV* stash
Expand Down Expand Up @@ -1770,7 +1770,7 @@ Ap |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\
|NULLOK GV *sv
Ap |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\
|NULLOK HV *sv
Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NN const MAGIC *mg|I32 nest \
Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NULLOK const MAGIC *mg|I32 nest \
|I32 maxnest|bool dumpops|STRLEN pvlim
Ap |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o
Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm
Expand Down
23 changes: 0 additions & 23 deletions hv.c
Expand Up @@ -2096,11 +2096,6 @@ Perl_hv_iterinit(pTHX_ HV *hv)
{
PERL_ARGS_ASSERT_HV_ITERINIT;

/* FIXME: Are we not NULL, or do we croak? Place bets now! */

if (!hv)
Perl_croak(aTHX_ "Bad hash");

if (SvOOK(hv)) {
struct xpvhv_aux * iter = HvAUX(hv);
HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
Expand Down Expand Up @@ -2128,9 +2123,6 @@ Perl_hv_riter_p(pTHX_ HV *hv) {

PERL_ARGS_ASSERT_HV_RITER_P;

if (!hv)
Perl_croak(aTHX_ "Bad hash");

iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
return &(iter->xhv_riter);
}
Expand All @@ -2141,9 +2133,6 @@ Perl_hv_eiter_p(pTHX_ HV *hv) {

PERL_ARGS_ASSERT_HV_EITER_P;

if (!hv)
Perl_croak(aTHX_ "Bad hash");

iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
return &(iter->xhv_eiter);
}
Expand All @@ -2154,9 +2143,6 @@ Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {

PERL_ARGS_ASSERT_HV_RITER_SET;

if (!hv)
Perl_croak(aTHX_ "Bad hash");

if (SvOOK(hv)) {
iter = HvAUX(hv);
} else {
Expand All @@ -2175,9 +2161,6 @@ Perl_hv_rand_set(pTHX_ HV *hv, U32 new_xhv_rand) {
PERL_ARGS_ASSERT_HV_RAND_SET;

#ifdef PERL_HASH_RANDOMIZE_KEYS
if (!hv)
Perl_croak(aTHX_ "Bad hash");

if (SvOOK(hv)) {
iter = HvAUX(hv);
} else {
Expand All @@ -2195,9 +2178,6 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {

PERL_ARGS_ASSERT_HV_EITER_SET;

if (!hv)
Perl_croak(aTHX_ "Bad hash");

if (SvOOK(hv)) {
iter = HvAUX(hv);
} else {
Expand Down Expand Up @@ -2515,9 +2495,6 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)

PERL_ARGS_ASSERT_HV_ITERNEXT_FLAGS;

if (!hv)
Perl_croak(aTHX_ "Bad hash");

xhv = (XPVHV*)SvANY(hv);

if (!SvOOK(hv)) {
Expand Down
2 changes: 1 addition & 1 deletion mro.c
Expand Up @@ -685,7 +685,7 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
PERL_ARGS_ASSERT_MRO_CLEAN_ISAREV;

/* Delete our name from our former parents' isarevs. */
if(isa && HvARRAY(isa) && hv_iterinit(isa)) {
if(HvARRAY(isa) && hv_iterinit(isa)) {
SV **svp;
while((iter = hv_iternext(isa))) {
I32 klen;
Expand Down
13 changes: 6 additions & 7 deletions op.c
Expand Up @@ -400,7 +400,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
PERL_UNUSED_CONTEXT;
DEBUG_S_warn((aTHX_ "freeing slab %p", (void*)slab));
assert(slab->opslab_refcnt == 1);
for (; slab; slab = slab2) {
do {
slab2 = slab->opslab_next;
#ifdef DEBUGGING
slab->opslab_refcnt = ~(size_t)0;
Expand All @@ -415,7 +415,8 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
#else
PerlMemShared_free(slab);
#endif
}
slab = slab2;
} while (slab);
}

void
Expand Down Expand Up @@ -3236,7 +3237,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)

PERL_ARGS_ASSERT_DOREF;

if (!o || (PL_parser && PL_parser->error_count))
if (PL_parser && PL_parser->error_count)
return o;

switch (o->op_type) {
Expand Down Expand Up @@ -8390,7 +8391,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
if (slab)
Slab_to_ro(slab);
#endif
if (o) op_free(o);
op_free(o);
return cv;
}

Expand Down Expand Up @@ -9080,9 +9081,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
bool interleave = FALSE;

PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
if (!subaddr)
Perl_croak_nocontext("panic: no address for '%s' in '%s'",
name, filename ? filename : PL_xsubfilename);

{
GV * const gv = gv_fetchpvn(
name ? name : PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
Expand Down
10 changes: 4 additions & 6 deletions perl.c
Expand Up @@ -2601,13 +2601,11 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, char **argv)
PERL_ARGS_ASSERT_CALL_ARGV;

PUSHMARK(SP);
if (argv) {
while (*argv) {
mXPUSHs(newSVpv(*argv,0));
argv++;
}
PUTBACK;
while (*argv) {
mXPUSHs(newSVpv(*argv,0));
argv++;
}
PUTBACK;
return call_pv(sub_name, flags);
}

Expand Down
2 changes: 1 addition & 1 deletion pp_sys.c
Expand Up @@ -4806,7 +4806,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)

PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;

if (array && *array) {
if (*array) {
target = newSVpvs_flags("", SVs_TEMP);
while (1) {
sv_catpv(target, *array);
Expand Down
11 changes: 3 additions & 8 deletions proto.h
Expand Up @@ -986,10 +986,9 @@ PERL_CALLCONV void Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp)
assert(sv); assert(delim); assert(mark); assert(sp)

PERL_CALLCONV void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_DO_MAGIC_DUMP \
assert(file); assert(mg)
assert(file)

PERL_CALLCONV I32 Perl_do_ncmp(pTHX_ SV *const left, SV *const right)
__attribute__warn_unused_result__
Expand Down Expand Up @@ -1427,11 +1426,7 @@ PERL_CALLCONV SV* Perl_gv_const_sv(pTHX_ GV* gv)
#define PERL_ARGS_ASSERT_GV_CONST_SV \
assert(gv)

PERL_CALLCONV void Perl_gv_dump(pTHX_ GV* gv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_GV_DUMP \
assert(gv)

PERL_CALLCONV void Perl_gv_dump(pTHX_ GV* gv);
PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, const GV* gv)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
Expand Down
4 changes: 2 additions & 2 deletions regexec.c
Expand Up @@ -2783,7 +2783,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
PERL_UNUSED_ARG(data);

/* Be paranoid... */
if (prog == NULL || stringarg == NULL) {
if (prog == NULL) {
Perl_croak(aTHX_ "NULL regexp parameter");
}

Expand All @@ -2802,7 +2802,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
reginfo->ganch =
(flags & REXEC_IGNOREPOS)
? stringarg /* use start pos rather than pos() */
: (sv && (mg = mg_find_mglob(sv)) && mg->mg_len >= 0)
: ((mg = mg_find_mglob(sv)) && mg->mg_len >= 0)
/* Defined pos(): */
? strbeg + MgBYTEPOS(mg, sv, strbeg, strend-strbeg)
: strbeg; /* pos() not defined; use start of string */
Expand Down
4 changes: 1 addition & 3 deletions sv.c
Expand Up @@ -6306,8 +6306,6 @@ Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN l

PERL_ARGS_ASSERT_SV_INSERT_FLAGS;

if (!bigstr)
Perl_croak(aTHX_ "Can't modify nonexistent substring");
SvPV_force_flags(bigstr, curlen, flags);
(void)SvPOK_only_UTF8(bigstr);
if (offset + len > curlen) {
Expand Down Expand Up @@ -15352,7 +15350,7 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,

PERL_ARGS_ASSERT_SV_CAT_DECODE;

if (SvPOK(ssv) && SvPOK(dsv) && SvROK(encoding) && offset) {
if (SvPOK(ssv) && SvPOK(dsv) && SvROK(encoding)) {
SV *offsv;
dSP;
ENTER;
Expand Down
4 changes: 0 additions & 4 deletions util.c
Expand Up @@ -556,10 +556,6 @@ Perl_instr(const char *big, const char *little)

PERL_ARGS_ASSERT_INSTR;

/* libc prior to 4.6.27 (late 1994) did not work properly on a NULL
* 'little' */
if (!little)
return (char*)big;
return strstr((char*)big, (char*)little);
}

Expand Down

0 comments on commit 3dc7863

Please sign in to comment.