From ebf991a64f410ed0616f83425bd44af605e988c2 Mon Sep 17 00:00:00 2001 From: bulk88 Date: Wed, 9 Oct 2024 10:49:02 -0400 Subject: [PATCH] replace various sv_catpv(sv,"cstr") calls with len counted calls -perf reasons, even though I guess most of the code is rarely called since they are error branches, do it anyways, it is only 1 more assembly op (2-4 bytes) vs not including len, and skips strlen() overhead -GDBM_File.xs -'sv_catpv(sv, ": ");' gdbm: Define error codes; provide the global $gdbm_errno variable. 8b8b12225a4af2826a4714f04e9f7464766199c6 10/11/2021 11:58:44 AM regcomp.c -'sv_catpv(substitute_parse, ")");' -"sv_catpv(substitute_parse, SvPVX(this_sequence));" len is known, its an an SV with contents gen by core, probably from regexp pl code, if it was passing control codes to console on the regular, I assume that would've been fixed long ago, therefore we not trying eliminate user's null chars 9d53c4576e551530162e7cd79ab72ed81b1e1a0f 10/11/2012 11:49:31 PM PATCH: [perl #89774] multi-char fold + its fold in char class -'const char overflow_msg[] = "Code point' This was creating uncond a RW array on C stack from a RO global string, then sometimes passing ptr to C stk alloced array, to sv_catpv() -"sv_catpv(msg, prefix);" pass len to RO string 73b95840bb1b55d761ec2dd075d2a8c37fa94bf4 8/20/2018 8:31:04 PM Move \p{user-defined} to core from utf8_heavy.pl -mg.c Revision: b35e4f8b3f15f0474d08f63e1f479787e261f485 12/14/2013 9:48:00 PM Fix HP-UX $! failure -"sv_catpv(sv, UNKNOWN_ERRNO_MSG);" is a const literal -perlio.c -add comment about the unusual but correct stack array, its length can be const computed so do it -pp_ctl.c 46fc3d4c69a0adf236bfcba70daee7fd597cf30d 4/22/1997 8:00:00 AM [inseparable changes from match from perl-5.003_97g to perl-5.003_97h] -"sv_catpv(namesv, unixname);" seems to be left over after converting this area of code from an unsafe "strcat()" design, use len since we know it --- ext/GDBM_File/GDBM_File.pm | 2 +- ext/GDBM_File/GDBM_File.xs | 2 +- mg.c | 2 +- perlio.c | 5 +++-- pp_ctl.c | 2 +- regcomp.c | 23 ++++++++++++++--------- 6 files changed, 21 insertions(+), 15 deletions(-) diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 45a1a93cd5d3..3020b7c41b53 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -733,7 +733,7 @@ require XSLoader; ); # This module isn't dual life, so no need for dev version numbers. -$VERSION = '1.24'; +$VERSION = '1.25'; our $gdbm_errno; diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index 27e3fe44e49c..b4372827c2bf 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -241,7 +241,7 @@ get_gdbm_errno(pTHX_ IV idx, SV *sv) if (gdbm_check_syserr(gdbm_errno)) { SV *val = get_sv("!", 0); if (val) { - sv_catpv(sv, ": "); + sv_catpvs(sv, ": "); sv_catsv(sv, val); } } diff --git a/mg.c b/mg.c index c37707be462d..c2667fc73a87 100644 --- a/mg.c +++ b/mg.c @@ -819,7 +819,7 @@ S_fixup_errno_string(pTHX_ SV* sv) assert(SvOK(sv)); if(strEQ(SvPVX(sv), "")) { - sv_catpv(sv, UNKNOWN_ERRNO_MSG); + sv_catpvs(sv, UNKNOWN_ERRNO_MSG); } } diff --git a/perlio.c b/perlio.c index 46a1ffac074b..fc5322c1ba9a 100644 --- a/perlio.c +++ b/perlio.c @@ -5466,6 +5466,7 @@ PerlIO_tmpfile_flags(int imode) f = PerlIO_fdopen(fd, "w+b"); #elif ! defined(OS2) int fd = -1; + /* Perl_my_mkostemp_cloexec() writes to this buf */ char tempname[] = "/tmp/PerlIO_XXXXXX"; const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR"); SV * sv = NULL; @@ -5474,7 +5475,7 @@ PerlIO_tmpfile_flags(int imode) if (tmpdir && *tmpdir) { /* if TMPDIR is set and not empty, we try that first */ sv = newSVpv(tmpdir, 0); - sv_catpv(sv, tempname + 4); + sv_catpvn(sv, tempname + 4, C_ARRAY_LENGTH(tempname)-4); fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); } if (fd < 0) { @@ -5486,7 +5487,7 @@ PerlIO_tmpfile_flags(int imode) if (fd < 0) { /* Try cwd */ sv = newSVpvs("."); - sv_catpv(sv, tempname + 4); + sv_catpvn(sv, tempname + 4, C_ARRAY_LENGTH(tempname)-4); fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); } umask(old_umask); diff --git a/pp_ctl.c b/pp_ctl.c index f7d81c349d50..bb20254aedbf 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4960,7 +4960,7 @@ S_require_file(pTHX_ SV *sv) == NULL) continue; sv_setpv(namesv, unixdir); - sv_catpv(namesv, unixname); + sv_catpvn(namesv, unixname, unixlen); #else /* The equivalent of Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); diff --git a/regcomp.c b/regcomp.c index e5f899aa4c43..78faa9f4c586 100644 --- a/regcomp.c +++ b/regcomp.c @@ -5320,7 +5320,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, substitute_parse = newSVpvs("?:"); sv_catsv(substitute_parse, value_sv); - sv_catpv(substitute_parse, ")"); + sv_catpvs(substitute_parse, ")"); /* The value should already be native, so no need to convert on EBCDIC * platforms.*/ @@ -10752,7 +10752,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } first_time = FALSE; - sv_catpv(substitute_parse, SvPVX(this_sequence)); + sv_catpvn(substitute_parse, + SvPVX(this_sequence), SvCUR(this_sequence)); } } } @@ -14222,7 +14223,6 @@ S_handle_user_defined_property(pTHX_ const char * s0 = string; /* Points to first byte in the current line being parsed in 'string' */ - const char overflow_msg[] = "Code point too large in \""; SV* running_definition = NULL; PERL_ARGS_ASSERT_HANDLE_USER_DEFINED_PROPERTY; @@ -14279,7 +14279,7 @@ S_handle_user_defined_property(pTHX_ s = e; } if (SvCUR(msg) > 0) sv_catpvs(msg, "; "); - sv_catpv(msg, overflow_msg); + sv_catpvs(msg, "Code point too large in \""); Perl_sv_catpvf(aTHX_ msg, "%" UTF8f, UTF8fARG(is_contents_utf8, s - s0, s0)); sv_catpvs(msg, "\""); @@ -14314,7 +14314,7 @@ S_handle_user_defined_property(pTHX_ s = e; } if (SvCUR(msg) > 0) sv_catpvs(msg, "; "); - sv_catpv(msg, overflow_msg); + sv_catpvs(msg, "Code point too large in \""); Perl_sv_catpvf(aTHX_ msg, "%" UTF8f, UTF8fARG(is_contents_utf8, s - s0, s0)); sv_catpvs(msg, "\""); @@ -15929,12 +15929,17 @@ S_parse_uniprop_string(pTHX_ append_name_to_msg: { - const char * prefix = (runtime && level == 0) ? " \\p{" : " \""; - const char * suffix = (runtime && level == 0) ? "}" : "\""; + bool is_root = runtime && level == 0; + const char * prefix = is_root ? " \\p{" : " \""; + Size_t prefixl = is_root ? STRLENs(" \\p{") : STRLENs(" \""); + const char * suffix; + Size_t suffixl; - sv_catpv(msg, prefix); + sv_catpvn(msg, prefix, prefixl); Perl_sv_catpvf(aTHX_ msg, "%" UTF8f, UTF8fARG(is_utf8, name_len, name)); - sv_catpv(msg, suffix); + suffix = is_root ? "}" : "\""; + suffixl = is_root ? STRLENs("}") : STRLENs("\""); + sv_catpvn(msg, suffix, suffixl); } return NULL;