In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d3bd3509f493e2e5b7dce62da1588008db56b899?hp=7eff3d39584e66495e9104149bc4f73e65307c84>
- Log ----------------------------------------------------------------- commit d3bd3509f493e2e5b7dce62da1588008db56b899 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 vxs.inc: use new SvPVCLEAR and constant string friendly macros M vxs.inc commit 7394beb1401a6ac5e5e19cff7f08486e5141126c Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 vutil.c: use new SvPVCLEAR and constant string friendly macros M vutil.c commit 9e2aa2e752c28a617095075e3f2a3505f0c0971a Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 utf8.c: use new SvPVCLEAR and constant string friendly macros M utf8.c commit fd9f609b370eafba6edf2f9a6a642062b585680a Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 universal.c: use new SvPVCLEAR and constant string friendly macros M universal.c commit 847cc851bfb3f7e208058189369c4b201c5073c0 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 toke.c: use new SvPVCLEAR and constant string friendly macros M toke.c commit f67714250da1360f690884805685cea58e9b40b0 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:27 2016 +0200 sv.c: use new SvPVCLEAR and constant string friendly macros M sv.c commit c6e2736d3a6018665c954ca91fa4a0a8517c57f8 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 regcomp.c: use new SvPVCLEAR and constant string friendly macros M regcomp.c commit 60e13354924e5699cc897e381bf48a16b2b75a0d Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 pp_sys.c: use new SvPVCLEAR and constant string friendly macros M pp_sys.c commit e8f7c79fe82af5804e5ea7902214cc4a9d992332 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 pp_pack.c: use new SvPVCLEAR and constant string friendly macros M pp_pack.c commit adf14ec66ef2f2908759585c3d71e0c01f6a17a4 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 pp_hot.c: use new SvPVCLEAR and constant string friendly macros M pp_hot.c commit 9aa3b533bfed3bd13a64b9eb6c9f65d894fffd8c Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 pp_ctl.c: use new SvPVCLEAR and constant string friendly macros M pp_ctl.c commit 500f3e18b91e55a2f60dfce9c896bac7c42c7e12 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 pp.c: use new SvPVCLEAR and constant string friendly macros M pp.c commit cad211cc730aa79357eb00584d9fffa239e49d2e Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 op.c: use new SvPVCLEAR and constant string friendly macros M op.c commit 26add6d4742e30776d0eece5905625b34ce3c2a3 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 numeric.c: use new SvPVCLEAR and constant string friendly macros M numeric.c commit 4d00dfae3cb125595c5230962f5b243f5a096dde Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 mro_core.c: use new SvPVCLEAR and constant string friendly macros M mro_core.c commit b2aed7751d929c14868a85d0da84e2f09a333507 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 mg.c: use new SvPVCLEAR and constant string friendly macros M mg.c commit 0eb7f56a1092ce1c626f58a4e605afe065b0464e Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 locale.c: use new SvPVCLEAR and constant string friendly macros M locale.c commit 9fb4aef8dd5425397148cefa4dbd8db6d0697216 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 hv.c: use new SvPVCLEAR and constant string friendly macros M hv.c commit ed0faf2e83103ec1f523eb2944e34634a4ed199d Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:26 2016 +0200 dump.c: use new SvPVCLEAR and constant string friendly macros M dump.c commit f607343fb1743090a7e00b2ce4e24d0594383019 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:25 2016 +0200 doop.c: use new SvPVCLEAR and constant string friendly macros M doop.c commit 8062ff1195ad9662d4b0c6d259bc4588043da98a Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:14:25 2016 +0200 doio.c: use new SvPVCLEAR and constant string friendly macros M doio.c commit eafd371ce091bf61fe1673448eee5e53c4b0ef32 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:09:00 2016 +0200 gv.c: rework special var matching logic to be simpler The old code used a bunch of tricks that IMO are unlikely to actually make any performance difference, and make the code harder to read, search, and understand, and less amenable to using string constant friendly macros. So for instance instead of switching on the first char and then comparing the second on for an exact match instead just compare the full string. The extra char is unlikely to make a difference to the underlying code that gets called, and the end result is easier searching. Another issue is that some of the code was inadverdantly doing prefix matches, and not exact matchs for certain magic var names. This is fixed as part of these changes. M gv.c commit 9b7f107c71adc4ec97fdd079ad9cb52f2f5b1f16 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:08:10 2016 +0200 gv.c: rework string separator parsing to use new string macros M gv.c commit 4c4f3c460b09605e6c2b95532cf0daabcea02e0c Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:07:40 2016 +0200 gv.c: switch to using string constant friendly macros M gv.c commit 7c7191346eb6e45ab1b688d3cd3000c0ab459fec Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:06:26 2016 +0200 gv.c: add a require_tie_mod_s() wrapper for constant string args M gv.c commit 854da30f7a12360c4116d0fe1bbfd4154f69ba24 Author: Yves Orton <[email protected]> Date: Wed Oct 19 11:01:08 2016 +0200 perl.[ch]: switch to using SvPVCLEAR() and string constant friendly macros M perl.c M perl.h commit 2808d9d83c4e997cfe6f2f74160017418f7db638 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:59:06 2016 +0200 vms: use hv_fetchs() with constant string key M vms/vms.c commit 5b1fede8986da7d83b67c4c43368188050e5d609 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:58:30 2016 +0200 pod: mention SvPVCLEAR() M pod/perlguts.pod M pod/perlhacktut.pod commit 94faf207d5729038862ef9ec157e4f813be03357 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:56:44 2016 +0200 amigaos4: use constant string friendly macros M amigaos4/amigaio.c commit e046b0f284831a0dbc4aebba81c2ab2dad9c68d3 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:56:00 2016 +0200 dist/Data-Dumper: switch to using SvPVCLEAR() M dist/Data-Dumper/Dumper.xs commit 4f72e1e921be7caffd7029f421f171bad7f485f2 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:55:40 2016 +0200 Storable: switch to using SvPVCLEAR() M dist/Storable/Storable.xs commit 75a8281e37646c26abf7e3ff244ff034bd3290e5 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:54:54 2016 +0200 os2: switch to using string constant friendly macros M os2/OS2/OS2-REXX/DLL/DLL.xs M os2/os2.c commit 33e1c218dc71ef08ace13dd2e6b7dfb8701eaeaf Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:54:05 2016 +0200 ext/XS-APItest: switch to using strEQs() this could use further love, and switch to using memEQs() in many places. M ext/XS-APItest/APItest.xs commit a3c1b8327666d11076ce270db674b63168149831 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:52:28 2016 +0200 ext/mro: use memEQs() for constant string checks M ext/mro/mro.pm M ext/mro/mro.xs commit 68fbdc7cf66118cc69542a28a02294de2158c2c5 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:50:58 2016 +0200 ext/PerlIO-encoding: use SvPVCLEAR() M ext/PerlIO-encoding/encoding.xs commit f7806eea88e5aba9e71c6bb718cccd7f2e85a8e4 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:50:19 2016 +0200 ext/POSIX: use _memEQs() and not memEQ() for constant string comparison M ext/POSIX/POSIX.xs commit 752602b13595db3fed3bcca882e24d5fa533be42 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:49:40 2016 +0200 ext/B: use strEQs() and strEQ() in expressions M ext/B/B.xs commit c0dea56fe487504493d97df5a7a6be57a2d2834d Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:48:21 2016 +0200 ext/VMS-Stdio: switch to using macros designed for string constant args M ext/VMS-Stdio/Stdio.pm M ext/VMS-Stdio/Stdio.xs commit 712f3a554c1afb72cddbe13be9fa16e898820ced Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:47:01 2016 +0200 ext/attributes: use _memEQs() when comparing to string arguments M ext/attributes/attributes.pm M ext/attributes/attributes.xs commit 9dd7321f6c6a35d582480f0f1f771dc451a71b16 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:44:53 2016 +0200 Devel-Peek: use hv_fetchs() when the key is a constant string M ext/Devel-Peek/Peek.pm M ext/Devel-Peek/Peek.xs commit 45661033e6be88d16397139fbd546cb1c7f8cd56 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:40:29 2016 +0200 sv.c: add sv_setpv_bufsize() and SvPVCLEAR() The first can be used to wrap several SVPV steps into a single sub, and a wrapper macro which is the equivalent of $s= ""; but is optimized in various ways. M embed.fnc M embed.h M proto.h M sv.c M sv.h commit 4ac46235a35c3293a6effa2b38b5fe6e37ef7985 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:36:14 2016 +0200 handy.h, hv.h: fixup hash s suffix macro definitions, move to hv.h For some reason s suffix macro definitions intended for handling constant string arguments were put into handy.h and not into hv.h. I think this is wrong, especially as the macro defintions have "drifted" and are not properly defined in terms the right base macros. Also we want to have such wrappers for the main hash functions, so move them all to hv.h, recode them properly in terms of the right base macros, and add support for the missing functions. M handy.h M hv.h commit 777fa2cb699b74cad6714d203572533dbd583976 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:32:29 2016 +0200 handy.h: add _memEQs() and _memNEs() for use with constant strings memEQs() is already defined, and requires a length parameter for the first pointer argument. However some times we do not have this length handy and simply want to use the length of the constant string instead. In an ideal world, to be compatible with more s suffix macros, IMO the existing memEQs() should have been called something like memEQsl() maybe, and the ones I am adding would get the memEQs( name, but it didnt work out like that. M handy.h commit 62946e08d24766c73755a22909c985cbf0a1b970 Author: Yves Orton <[email protected]> Date: Wed Oct 19 10:30:44 2016 +0200 handy.h: add strEQs() and strNEs() for comparing to constant strings They use strncmp() and derive the length using STR_WITH_LEN style tricks in the wrapper call. M handy.h commit 754f85ad23f74b8468a982af104f0975723e2343 Author: Yves Orton <[email protected]> Date: Thu Oct 13 18:41:00 2016 +0200 gv.c: document where @- and @+ (and %- and %+ are initialized in gv.c) M gv.c commit 5656b1f654bb034c561558968ed3cf87a737b3e1 Author: Yves Orton <[email protected]> Date: Wed Oct 19 09:52:01 2016 +0200 uniprops.t: split into 10 seperate test files t/re/uniprops01.t etc This way we can run them at the same time under parallel test, as there are a lot of tests (140k or so) this makes a difference. M MANIFEST M charclass_invlists.h M lib/unicore/mktables M regcharclass.h R098 t/re/uniprops.t t/re/uniprops01.t A t/re/uniprops02.t A t/re/uniprops03.t A t/re/uniprops04.t A t/re/uniprops05.t A t/re/uniprops06.t A t/re/uniprops07.t A t/re/uniprops08.t A t/re/uniprops09.t A t/re/uniprops10.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 11 +++- amigaos4/amigaio.c | 2 +- charclass_invlists.h | 2 +- dist/Data-Dumper/Dumper.xs | 2 +- dist/Storable/Storable.xs | 4 +- doio.c | 12 ++--- doop.c | 4 +- dump.c | 8 +-- embed.fnc | 1 + embed.h | 1 + ext/B/B.xs | 4 +- ext/Devel-Peek/Peek.pm | 2 +- ext/Devel-Peek/Peek.xs | 28 +++++----- ext/POSIX/POSIX.xs | 2 +- ext/PerlIO-encoding/encoding.xs | 2 +- ext/VMS-Stdio/Stdio.pm | 2 +- ext/VMS-Stdio/Stdio.xs | 6 +-- ext/XS-APItest/APItest.xs | 44 ++++++++-------- ext/attributes/attributes.pm | 2 +- ext/attributes/attributes.xs | 8 +-- ext/mro/mro.pm | 2 +- ext/mro/mro.xs | 6 +-- gv.c | 108 +++++++++++++++++++++----------------- handy.h | 20 ++++--- hv.c | 2 +- hv.h | 20 +++++++ lib/unicore/mktables | 60 ++++++++++++++------- locale.c | 4 +- mg.c | 12 ++--- mro_core.c | 14 ++--- numeric.c | 2 +- op.c | 6 +-- os2/OS2/OS2-REXX/DLL/DLL.xs | 2 +- os2/os2.c | 18 +++---- perl.c | 20 +++---- perl.h | 2 +- pod/perlguts.pod | 2 +- pod/perlhacktut.pod | 2 +- pp.c | 27 +++++----- pp_ctl.c | 2 +- pp_hot.c | 2 +- pp_pack.c | 2 +- pp_sys.c | 8 +-- proto.h | 3 ++ regcharclass.h | 2 +- regcomp.c | 4 +- sv.c | 39 ++++++++++++-- sv.h | 5 ++ t/re/{uniprops.t => uniprops01.t} | 1 + t/re/{uniprops.t => uniprops02.t} | 1 + t/re/{uniprops.t => uniprops03.t} | 1 + t/re/{uniprops.t => uniprops04.t} | 1 + t/re/{uniprops.t => uniprops05.t} | 1 + t/re/{uniprops.t => uniprops06.t} | 1 + t/re/{uniprops.t => uniprops07.t} | 1 + t/re/{uniprops.t => uniprops08.t} | 1 + t/re/{uniprops.t => uniprops09.t} | 1 + t/re/{uniprops.t => uniprops10.t} | 1 + toke.c | 44 ++++++++-------- universal.c | 6 +-- utf8.c | 2 +- vms/vms.c | 2 +- vutil.c | 8 +-- vxs.inc | 2 +- 64 files changed, 366 insertions(+), 251 deletions(-) copy t/re/{uniprops.t => uniprops01.t} (98%) copy t/re/{uniprops.t => uniprops02.t} (98%) copy t/re/{uniprops.t => uniprops03.t} (98%) copy t/re/{uniprops.t => uniprops04.t} (98%) copy t/re/{uniprops.t => uniprops05.t} (98%) copy t/re/{uniprops.t => uniprops06.t} (98%) copy t/re/{uniprops.t => uniprops07.t} (98%) copy t/re/{uniprops.t => uniprops08.t} (98%) copy t/re/{uniprops.t => uniprops09.t} (98%) rename t/re/{uniprops.t => uniprops10.t} (98%) diff --git a/MANIFEST b/MANIFEST index 0a895d7..710a81b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5713,7 +5713,16 @@ t/re/subst.t See if substitution works t/re/subst_amp.t See if $&-related substitution works t/re/subst_wamp.t See if substitution works with $& present t/re/substT.t See if substitution works with -T -t/re/uniprops.t Test unicode \p{} regex constructs +t/re/uniprops01.t Test unicode \p{} regex constructs +t/re/uniprops02.t Test unicode \p{} regex constructs +t/re/uniprops03.t Test unicode \p{} regex constructs +t/re/uniprops04.t Test unicode \p{} regex constructs +t/re/uniprops05.t Test unicode \p{} regex constructs +t/re/uniprops06.t Test unicode \p{} regex constructs +t/re/uniprops07.t Test unicode \p{} regex constructs +t/re/uniprops08.t Test unicode \p{} regex constructs +t/re/uniprops09.t Test unicode \p{} regex constructs +t/re/uniprops10.t Test unicode \p{} regex constructs t/README Instructions for regression tests t/run/cloexec.t Test close-on-exec. t/run/dtrace.pl For dtrace.t diff --git a/amigaos4/amigaio.c b/amigaos4/amigaio.c index 205e3d5..b50dd9b 100644 --- a/amigaos4/amigaio.c +++ b/amigaos4/amigaio.c @@ -668,7 +668,7 @@ static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report) if (*cmd == '.' && isSPACE(cmd[1])) goto doshell; - if (strnEQ(cmd, "exec", 4) && isSPACE(cmd[4])) + if (strEQs(cmd, "exec") && isSPACE(cmd[4])) goto doshell; s = cmd; diff --git a/charclass_invlists.h b/charclass_invlists.h index 390e8a0..1613dda 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -91558,7 +91558,7 @@ static const U8 WB_table[24][24] = { * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 lib/unicore/extracted/DLineBreak.txt * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 lib/unicore/extracted/DNumType.txt * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 lib/unicore/extracted/DNumValues.txt - * 5c7eb94310e2aaa15702fd6bed24ff0e7ab5448f9a8231d8c49ca96c9e941089 lib/unicore/mktables + * 421444fcd83fcdfecffa743c8888c3a1a8e88bcde472a80fca57d199ec5db10a lib/unicore/mktables * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl * 11011bc761487f5a63c8135e67248394d4cdff6f8f204a41cdfbdc8131e79406 regen/mk_invlists.pl diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 017904e..25886d7 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -1575,7 +1575,7 @@ Data_Dumper_Dumpxs(href, ...) sv_catpvs(retval, ";"); sv_catsv(retval, style.sep); } - sv_setpvs(valstr, ""); + SvPVCLEAR(valstr); if (gimme == G_ARRAY) { XPUSHs(sv_2mortal(retval)); if (i < imax) /* not the last time thro ? */ diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index a5f8ecd..053951c 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -4894,7 +4894,7 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ if (len == 0) { - sv_setpvs(sv, ""); + SvPVCLEAR(sv); return sv; } @@ -5684,7 +5684,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) SAVETMPS; errsv = get_sv("@", GV_ADD); - sv_setpvs(errsv, ""); /* clear $@ */ + SvPVCLEAR(errsv); /* clear $@ */ if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) { PUSHMARK(sp); XPUSHs(sv_2mortal(newSVsv(sub))); diff --git a/doio.c b/doio.c index b8f3c28..a11b64d 100644 --- a/doio.c +++ b/doio.c @@ -899,7 +899,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) const char *star = strchr(PL_inplace, '*'); if (star) { const char *begin = PL_inplace; - sv_setpvs(sv, ""); + SvPVCLEAR(sv); do { sv_catpvn(sv, begin, star - begin); sv_catpvn(sv, PL_oldname, oldlen); @@ -1435,7 +1435,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags) do_fstat_have_io: PL_laststype = OP_STAT; PL_statgv = gv ? gv : (GV *)io; - sv_setpvs(PL_statname, ""); + SvPVCLEAR(PL_statname); if (io) { if (IoIFP(io)) { int fd = PerlIO_fileno(IoIFP(io)); @@ -1639,7 +1639,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) { char flags[PERL_FLAGS_MAX]; if (strnEQ(cmd,PL_cshname,PL_cshlen) && - strnEQ(cmd+PL_cshlen," -c",3)) { + strEQs(cmd+PL_cshlen," -c")) { my_strlcpy(flags, "-c", PERL_FLAGS_MAX); s = cmd+PL_cshlen+3; if (*s == 'f') { @@ -1675,7 +1675,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (*cmd == '.' && isSPACE(cmd[1])) goto doshell; - if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) + if (strEQs(cmd,"exec") && isSPACE(cmd[4])) goto doshell; s = cmd; @@ -2389,7 +2389,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) /* suppress warning when reading into undef var --jhi */ if (! SvOK(mstr)) - sv_setpvs(mstr, ""); + SvPVCLEAR(mstr); msize = SvIVx(*++mark); mtype = (long)SvIVx(*++mark); flags = SvIVx(*++mark); @@ -2500,7 +2500,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) SvGETMAGIC(mstr); SvUPGRADE(mstr, SVt_PV); if (! SvOK(mstr)) - sv_setpvs(mstr, ""); + SvPVCLEAR(mstr); SvPOK_only(mstr); mbuf = SvGROW(mstr, (STRLEN)msize+1); diff --git a/doop.c b/doop.c index 79cf4b6..5525c47 100644 --- a/doop.c +++ b/doop.c @@ -680,7 +680,7 @@ Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp) ++mark; } - sv_setpvs(sv, ""); + SvPVCLEAR(sv); /* sv_setpv retains old UTF8ness [perl #24846] */ SvUTF8_off(sv); @@ -1008,7 +1008,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) PERL_ARGS_ASSERT_DO_VOP; if (sv != left || (optype != OP_BIT_AND && !SvOK(sv))) - sv_setpvs(sv, ""); /* avoid undef warning on |= and ^= */ + SvPVCLEAR(sv); /* avoid undef warning on |= and ^= */ if (sv == left) { lsave = lc = SvPV_force_nomg(left, leftlen); } diff --git a/dump.c b/dump.c index 5f75338..d2d7f67 100644 --- a/dump.c +++ b/dump.c @@ -156,7 +156,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) { /* This won't alter the UTF-8 flag */ - sv_setpvs(dsv, ""); + SvPVCLEAR(dsv); } if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) @@ -285,7 +285,7 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, if (!(flags & PERL_PV_PRETTY_NOCLEAR)) { /* This won't alter the UTF-8 flag */ - sv_setpvs(dsv, ""); + SvPVCLEAR(dsv); } orig_cur= SvCUR(dsv); @@ -358,7 +358,7 @@ Perl_sv_peek(pTHX_ SV *sv) int unref = 0; U32 type; - sv_setpvs(t, ""); + SvPVCLEAR(t); retry: if (!sv) { sv_catpv(t, "VOID"); @@ -1674,7 +1674,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0); - sv_setpvs(d, ""); + SvPVCLEAR(d); if (AvREAL(sv)) sv_catpv(d, ",REAL"); if (AvREIFY(sv)) sv_catpv(d, ",REIFY"); Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", diff --git a/embed.fnc b/embed.fnc index 46426b6..3e0e844 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1566,6 +1566,7 @@ Apd |SV* |sv_setref_pvn |NN SV *const rv|NULLOK const char *const classname \ |NN const char *const pv|const STRLEN n Apd |void |sv_setpv |NN SV *const sv|NULLOK const char *const ptr Apd |void |sv_setpvn |NN SV *const sv|NULLOK const char *const ptr|const STRLEN len +Apd |char *|sv_setpv_bufsize|NN SV *const sv|const STRLEN cur|const STRLEN len Xp |void |sv_sethek |NN SV *const sv|NULLOK const HEK *const hek Apmdb |void |sv_setsv |NN SV *dstr|NULLOK SV *sstr Apmdb |void |sv_taint |NN SV* sv diff --git a/embed.h b/embed.h index 5df381c..7ccf06f 100644 --- a/embed.h +++ b/embed.h @@ -669,6 +669,7 @@ #define sv_setnv(a,b) Perl_sv_setnv(aTHX_ a,b) #define sv_setnv_mg(a,b) Perl_sv_setnv_mg(aTHX_ a,b) #define sv_setpv(a,b) Perl_sv_setpv(aTHX_ a,b) +#define sv_setpv_bufsize(a,b,c) Perl_sv_setpv_bufsize(aTHX_ a,b,c) #define sv_setpv_mg(a,b) Perl_sv_setpv_mg(aTHX_ a,b) #ifndef PERL_IMPLICIT_CONTEXT #define sv_setpvf Perl_sv_setpvf diff --git a/ext/B/B.xs b/ext/B/B.xs index 0490352..0352901 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -894,11 +894,11 @@ CODE: int i; IV result = -1; ST(0) = sv_newmortal(); - if (strncmp(name,"pp_",3) == 0) + if (strEQs(name,"pp_")) name += 3; for (i = 0; i < PL_maxo; i++) { - if (strcmp(name, PL_op_name[i]) == 0) + if (strEQ(name, PL_op_name[i])) { result = i; break; diff --git a/ext/Devel-Peek/Peek.pm b/ext/Devel-Peek/Peek.pm index 2c57cba..f3ce70f 100644 --- a/ext/Devel-Peek/Peek.pm +++ b/ext/Devel-Peek/Peek.pm @@ -3,7 +3,7 @@ package Devel::Peek; -$VERSION = '1.24'; +$VERSION = '1.25'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/ext/Devel-Peek/Peek.xs b/ext/Devel-Peek/Peek.xs index 132cad79..2d9895b 100644 --- a/ext/Devel-Peek/Peek.xs +++ b/ext/Devel-Peek/Peek.xs @@ -181,46 +181,46 @@ _mstats_to_hv(HV *hv, const struct mstats_buffer *b, int level) SV **svp; int type; - svp = hv_fetch(hv, "topbucket", 9, 1); + svp = hv_fetchs(hv, "topbucket", 1); sv_setiv(*svp, b->buffer.topbucket); - svp = hv_fetch(hv, "topbucket_ev", 12, 1); + svp = hv_fetchs(hv, "topbucket_ev", 1); sv_setiv(*svp, b->buffer.topbucket_ev); - svp = hv_fetch(hv, "topbucket_odd", 13, 1); + svp = hv_fetchs(hv, "topbucket_odd", 1); sv_setiv(*svp, b->buffer.topbucket_odd); - svp = hv_fetch(hv, "totfree", 7, 1); + svp = hv_fetchs(hv, "totfree", 1); sv_setiv(*svp, b->buffer.totfree); - svp = hv_fetch(hv, "total", 5, 1); + svp = hv_fetchs(hv, "total", 1); sv_setiv(*svp, b->buffer.total); - svp = hv_fetch(hv, "total_chain", 11, 1); + svp = hv_fetchs(hv, "total_chain", 1); sv_setiv(*svp, b->buffer.total_chain); - svp = hv_fetch(hv, "total_sbrk", 10, 1); + svp = hv_fetchs(hv, "total_sbrk", 1); sv_setiv(*svp, b->buffer.total_sbrk); - svp = hv_fetch(hv, "sbrks", 5, 1); + svp = hv_fetchs(hv, "sbrks", 1); sv_setiv(*svp, b->buffer.sbrks); - svp = hv_fetch(hv, "sbrk_good", 9, 1); + svp = hv_fetchs(hv, "sbrk_good", 1); sv_setiv(*svp, b->buffer.sbrk_good); - svp = hv_fetch(hv, "sbrk_slack", 10, 1); + svp = hv_fetchs(hv, "sbrk_slack", 1); sv_setiv(*svp, b->buffer.sbrk_slack); - svp = hv_fetch(hv, "start_slack", 11, 1); + svp = hv_fetchs(hv, "start_slack", 1); sv_setiv(*svp, b->buffer.start_slack); - svp = hv_fetch(hv, "sbrked_remains", 14, 1); + svp = hv_fetchs(hv, "sbrked_remains", 1); sv_setiv(*svp, b->buffer.sbrked_remains); - svp = hv_fetch(hv, "minbucket", 9, 1); + svp = hv_fetchs(hv, "minbucket", 1); sv_setiv(*svp, b->buffer.minbucket); - svp = hv_fetch(hv, "nbuckets", 8, 1); + svp = hv_fetchs(hv, "nbuckets", 1); sv_setiv(*svp, b->buffer.nbuckets); if (_NBUCKETS < b->buffer.nbuckets) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 672807a..b573f5e 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3006,7 +3006,7 @@ sigaction(sig, optaction, oldaction = 0) const char *s = SvPVX_const(ST(0)); int i = whichsig(s); - if (i < 0 && memEQ(s, "SIG", 3)) + if (i < 0 && _memEQs(s, "SIG")) i = whichsig(s + 3); if (i < 0) { if (ckWARN(WARN_SIGNAL)) diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 1101bf1..bb4754f 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -203,7 +203,7 @@ PerlIOEncode_get_base(pTHX_ PerlIO * f) e->base.bufsiz = 1024; if (!e->bufsv) { e->bufsv = newSV(e->base.bufsiz); - sv_setpvs(e->bufsv, ""); + SvPVCLEAR(e->bufsv); } e->base.buf = (STDCHAR *) SvPVX(e->bufsv); if (!e->base.ptr) diff --git a/ext/VMS-Stdio/Stdio.pm b/ext/VMS-Stdio/Stdio.pm index 4d05994..6474900 100644 --- a/ext/VMS-Stdio/Stdio.pm +++ b/ext/VMS-Stdio/Stdio.pm @@ -13,7 +13,7 @@ use Carp '&croak'; use DynaLoader (); use Exporter (); -$VERSION = '2.41'; +$VERSION = '2.42'; @ISA = qw( Exporter DynaLoader IO::File ); @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); diff --git a/ext/VMS-Stdio/Stdio.xs b/ext/VMS-Stdio/Stdio.xs index 144f937..5f20937 100644 --- a/ext/VMS-Stdio/Stdio.xs +++ b/ext/VMS-Stdio/Stdio.xs @@ -15,7 +15,7 @@ static bool constant(char *name, IV *pval) { - if (strnNE(name, "O_", 2)) return FALSE; + if (strNEs(name, "O_")) return FALSE; if (strEQ(name, "O_APPEND")) #ifdef O_APPEND @@ -88,10 +88,10 @@ newFH(PerlIO *fp, char type) { * symbol tables. This code (through io = ...) is really * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO), * with a little less overhead, and good exercise for me. :-) */ - stashp = (GV **)hv_fetch(PL_defstash,"VMS::",5,TRUE); + stashp = (GV **)hv_fetchs(PL_defstash,"VMS::",TRUE); if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL; if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); - stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE); + stashp = (GV **)hv_fetchs(GvHV(*stashp),"Stdio::",TRUE); if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL; if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 6b6f45f..6dbb297 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -157,8 +157,8 @@ test_freeent(freeent_function *f) { #else /* Storing then deleting something should ensure that a hash entry is available. */ - (void) hv_store(test_hash, "", 0, &PL_sv_yes, 0); - (void) hv_delete(test_hash, "", 0, 0); + (void) hv_stores(test_hash, "", &PL_sv_yes); + (void) hv_deletes(test_hash, "", 0); /* We need to "inline" new_he here as it's static, and the functions we test expect to be able to call del_HE on the HE */ @@ -1148,84 +1148,84 @@ static int THX_keyword_active(pTHX_ SV *hintkey_sv) static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) { - if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) && + if(keyword_len == 3 && strEQs(keyword_ptr, "rpn") && keyword_active(hintkey_rpn_sv)) { *op_ptr = parse_keyword_rpn(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) && + } else if(keyword_len == 7 && strEQs(keyword_ptr, "calcrpn") && keyword_active(hintkey_calcrpn_sv)) { *op_ptr = parse_keyword_calcrpn(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) && + } else if(keyword_len == 9 && strEQs(keyword_ptr, "stufftest") && keyword_active(hintkey_stufftest_sv)) { *op_ptr = parse_keyword_stufftest(); return KEYWORD_PLUGIN_STMT; } else if(keyword_len == 12 && - strnEQ(keyword_ptr, "swaptwostmts", 12) && + strEQs(keyword_ptr, "swaptwostmts") && keyword_active(hintkey_swaptwostmts_sv)) { *op_ptr = parse_keyword_swaptwostmts(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 8 && strnEQ(keyword_ptr, "looprest", 8) && + } else if(keyword_len == 8 && strEQs(keyword_ptr, "looprest") && keyword_active(hintkey_looprest_sv)) { *op_ptr = parse_keyword_looprest(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 14 && strnEQ(keyword_ptr, "scopelessblock", 14) && + } else if(keyword_len == 14 && strEQs(keyword_ptr, "scopelessblock") && keyword_active(hintkey_scopelessblock_sv)) { *op_ptr = parse_keyword_scopelessblock(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 10 && strnEQ(keyword_ptr, "stmtasexpr", 10) && + } else if(keyword_len == 10 && strEQs(keyword_ptr, "stmtasexpr") && keyword_active(hintkey_stmtasexpr_sv)) { *op_ptr = parse_keyword_stmtasexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 11 && strnEQ(keyword_ptr, "stmtsasexpr", 11) && + } else if(keyword_len == 11 && strEQs(keyword_ptr, "stmtsasexpr") && keyword_active(hintkey_stmtsasexpr_sv)) { *op_ptr = parse_keyword_stmtsasexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 9 && strnEQ(keyword_ptr, "loopblock", 9) && + } else if(keyword_len == 9 && strEQs(keyword_ptr, "loopblock") && keyword_active(hintkey_loopblock_sv)) { *op_ptr = parse_keyword_loopblock(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 11 && strnEQ(keyword_ptr, "blockasexpr", 11) && + } else if(keyword_len == 11 && strEQs(keyword_ptr, "blockasexpr") && keyword_active(hintkey_blockasexpr_sv)) { *op_ptr = parse_keyword_blockasexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 9 && strnEQ(keyword_ptr, "swaplabel", 9) && + } else if(keyword_len == 9 && strEQs(keyword_ptr, "swaplabel") && keyword_active(hintkey_swaplabel_sv)) { *op_ptr = parse_keyword_swaplabel(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 10 && strnEQ(keyword_ptr, "labelconst", 10) && + } else if(keyword_len == 10 && strEQs(keyword_ptr, "labelconst") && keyword_active(hintkey_labelconst_sv)) { *op_ptr = parse_keyword_labelconst(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arrayfullexpr", 13) && + } else if(keyword_len == 13 && strEQs(keyword_ptr, "arrayfullexpr") && keyword_active(hintkey_arrayfullexpr_sv)) { *op_ptr = parse_keyword_arrayfullexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraylistexpr", 13) && + } else if(keyword_len == 13 && strEQs(keyword_ptr, "arraylistexpr") && keyword_active(hintkey_arraylistexpr_sv)) { *op_ptr = parse_keyword_arraylistexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraytermexpr", 13) && + } else if(keyword_len == 13 && strEQs(keyword_ptr, "arraytermexpr") && keyword_active(hintkey_arraytermexpr_sv)) { *op_ptr = parse_keyword_arraytermexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayarithexpr", 14) && + } else if(keyword_len == 14 && strEQs(keyword_ptr, "arrayarithexpr") && keyword_active(hintkey_arrayarithexpr_sv)) { *op_ptr = parse_keyword_arrayarithexpr(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayexprflags", 14) && + } else if(keyword_len == 14 && strEQs(keyword_ptr, "arrayexprflags") && keyword_active(hintkey_arrayexprflags_sv)) { *op_ptr = parse_keyword_arrayexprflags(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 5 && strnEQ(keyword_ptr, "DEFSV", 5) && + } else if(keyword_len == 5 && strEQs(keyword_ptr, "DEFSV") && keyword_active(hintkey_DEFSV_sv)) { *op_ptr = parse_keyword_DEFSV(); return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 9 && strnEQ(keyword_ptr, "with_vars", 9) && + } else if(keyword_len == 9 && strEQs(keyword_ptr, "with_vars") && keyword_active(hintkey_with_vars_sv)) { *op_ptr = parse_keyword_with_vars(); return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 15 && strnEQ(keyword_ptr, "join_with_space", 15) && + } else if(keyword_len == 15 && strEQs(keyword_ptr, "join_with_space") && keyword_active(hintkey_join_with_space_sv)) { *op_ptr = parse_join_with_space(); return KEYWORD_PLUGIN_EXPR; diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm index f7af31b..67662e4 100644 --- a/ext/attributes/attributes.pm +++ b/ext/attributes/attributes.pm @@ -1,6 +1,6 @@ package attributes; -our $VERSION = 0.27; +our $VERSION = 0.28; @EXPORT_OK = qw(get reftype); @EXPORT = (); diff --git a/ext/attributes/attributes.xs b/ext/attributes/attributes.xs index d98fd9e..287ac34 100644 --- a/ext/attributes/attributes.xs +++ b/ext/attributes/attributes.xs @@ -44,7 +44,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) case SVt_PVCV: switch ((int)len) { case 5: - if (memEQ(name, "const", 5)) { + if (_memEQs(name, "const")) { if (negated) CvANONCONST_off(sv); else { @@ -60,7 +60,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) case 6: switch (name[3]) { case 'l': - if (memEQ(name, "lvalue", 6)) { + if (_memEQs(name, "lvalue")) { bool warn = !CvISXSUB(MUTABLE_CV(sv)) && CvROOT(MUTABLE_CV(sv)) @@ -74,7 +74,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) } break; case 'h': - if (memEQ(name, "method", 6)) { + if (_memEQs(name, "method")) { if (negated) CvFLAGS(MUTABLE_CV(sv)) &= ~CVf_METHOD; else @@ -85,7 +85,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) } break; default: - if (len > 10 && memEQ(name, "prototype(", 10)) { + if (len > 10 && _memEQs(name, "prototype(")) { SV * proto = newSVpvn(name+10,len-11); HEK *const hek = CvNAME_HEK((CV *)sv); SV *subname; diff --git a/ext/mro/mro.pm b/ext/mro/mro.pm index 0946fb6..5df944c 100644 --- a/ext/mro/mro.pm +++ b/ext/mro/mro.pm @@ -12,7 +12,7 @@ use warnings; # mro.pm versions < 1.00 reserved for MRO::Compat # for partial back-compat to 5.[68].x -our $VERSION = '1.18'; +our $VERSION = '1.19'; sub import { mro::set_mro(scalar(caller), $_[1]) if $_[1]; diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs index 6d891ae..f51d54a 100644 --- a/ext/mro/mro.xs +++ b/ext/mro/mro.xs @@ -431,8 +431,8 @@ mro_is_universal(...) he = hv_fetch_ent(PL_isarev, classname, 0, 0); isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL; - if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL")) - || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) + if((memEQs(classname_pv, classname_len, "UNIVERSAL")) + || (isarev && hv_existss(isarev, "UNIVERSAL"))) XSRETURN_YES; else XSRETURN_NO; @@ -566,7 +566,7 @@ mro__nextcan(...) subname++; subname_len = fq_subname_len - (subname - fq_subname); - if(subname_len == 8 && strEQ(subname, "__ANON__")) { + if(memEQs(subname, subname_len, "__ANON__")) { cxix = __dopoptosub_at(ccstack, cxix - 1); continue; } diff --git a/gv.c b/gv.c index 3237c53..9ae3eb6 100644 --- a/gv.c +++ b/gv.c @@ -84,7 +84,7 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) { *where = newSV_type(type); if (type == SVt_PVAV && GvNAMELEN(gv) == 3 - && strnEQ(GvNAME(gv), "ISA", 3)) + && strEQs(GvNAME(gv), "ISA")) sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0); } return gv; @@ -770,7 +770,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, } else if (stash == cachestash && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4 - && strnEQ(hvname, "CORE", 4) + && strEQs(hvname, "CORE") && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len)) goto have_gv; } @@ -797,7 +797,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, if (!gvp) { if (len > 1 && HvNAMELEN_get(cstash) == 4) { const char *hvname = HvNAME(cstash); assert(hvname); - if (strnEQ(hvname, "CORE", 4) + if (strEQs(hvname, "CORE") && (candidate = S_maybe_add_coresub(aTHX_ cstash,NULL,name,len) )) @@ -1056,22 +1056,23 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le /* did we find a separator? */ if (last_separator) { - if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) { + STRLEN sep_len= last_separator - origname; + if ( memEQs(origname, sep_len, "SUPER")) { /* ->SUPER::method should really be looked up in original stash */ stash = CopSTASH(PL_curcop); flags |= GV_SUPER; DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", origname, HvENAME_get(stash), name) ); } - else if ((last_separator - origname) >= 7 && - strnEQ(last_separator - 7, "::SUPER", 7)) { + else if ( sep_len >= 7 && + strEQs(last_separator - 7, "::SUPER")) { /* don't autovifify if ->NoSuchStash::SUPER::method */ - stash = gv_stashpvn(origname, last_separator - origname - 7, is_utf8); + stash = gv_stashpvn(origname, sep_len - 7, is_utf8); if (stash) flags |= GV_SUPER; } else { /* don't autovifify if ->NoSuchStash::method */ - stash = gv_stashpvn(origname, last_separator - origname, is_utf8); + stash = gv_stashpvn(origname, sep_len, is_utf8); } ostash = stash; } @@ -1340,7 +1341,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name, ENTER; -#define HV_FETCH_TIE_FUNC (GV **)hv_fetch(stash, "_tie_it", 7, 0) +#define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0) /* Load the module if it is not loaded. */ if (!(stash = gv_stashpvn(name, len, 0)) @@ -1370,6 +1371,13 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name, } } +/* add a require_tie_mod_s - the _s suffix is similar to pvs type suffixes, + * IOW it means we do STR_WITH_LEN() ourselves and the user should pass in + * a true string WITHOUT a len. + */ +#define require_tie_mod_s(gv, varname, name, flags) \ + S_require_tie_mod(aTHX_ gv, varname, STR_WITH_LEN(name), flags) + /* =for apidoc gv_stashpv @@ -1633,8 +1641,8 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, *stash = GvHV(*gv) = newHV(); if (!HvNAME_get(*stash)) { if (GvSTASH(*gv) == PL_defstash && *len == 6 - && strnEQ(*name, "CORE", 4)) - hv_name_set(*stash, "CORE", 4, 0); + && strEQs(*name, "CORE")) + hv_name_sets(*stash, "CORE", 0); else hv_name_set( *stash, nambeg, name_cursor-nambeg, is_utf8 @@ -1846,25 +1854,28 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, and VERSION. All the others apply only to the main stash or to CORE (which is checked right after this). */ if (len) { - const char * const name2 = name + 1; switch (*name) { case 'E': - if (strnEQ(name2, "XPORT", 5)) + if (memEQs(name, len, "EXPORT") + ||memEQs(name, len, "EXPORT_OK") + ||memEQs(name, len, "EXPORT_FAIL") + ) GvMULTI_on(gv); break; case 'I': - if (strEQ(name2, "SA")) + if (memEQs(name, len, "ISA")) gv_magicalize_isa(gv); break; case 'V': - if (strEQ(name2, "ERSION")) + if (memEQs(name, len, "VERSION")) GvMULTI_on(gv); break; case 'a': - if (stash == PL_debstash && len==4 && strEQ(name2,"rgs")) { + if (stash == PL_debstash && memEQs(name, len, "args")) { GvMULTI_on(gv_AVadd(gv)); break; - } + } + /* FALLTHROUGH */ case 'b': if (len == 1 && sv_type == SVt_PV) GvMULTI_on(gv); @@ -1878,7 +1889,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) { /* Avoid null warning: */ const char * const stashname = HvNAME(stash); assert(stashname); - if (strnEQ(stashname, "CORE", 4)) + if (strEQs(stashname, "CORE")) S_maybe_add_coresub(aTHX_ 0, gv, name, len); } } @@ -1899,27 +1910,26 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, } else #endif { - const char * name2 = name + 1; switch (*name) { case 'A': - if (strEQ(name2, "RGV")) { + if (memEQs(name, len, "ARGV")) { IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; } - else if (strEQ(name2, "RGVOUT")) { + else if (memEQs(name, len, "ARGVOUT")) { GvMULTI_on(gv); } break; case 'E': - if (strnEQ(name2, "XPORT", 5)) + if (memEQs(name, len, "EXPORT")) GvMULTI_on(gv); break; case 'I': - if (strEQ(name2, "SA")) { + if (memEQs(name, len, "ISA")) { gv_magicalize_isa(gv); } break; case 'S': - if (strEQ(name2, "IG")) { + if (memEQs(name, len, "SIG")) { HV *hv; I32 i; if (!PL_psig_name) { @@ -1950,62 +1960,62 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, } break; case 'V': - if (strEQ(name2, "ERSION")) + if (memEQs(name, len, "VERSION")) GvMULTI_on(gv); break; case '\003': /* $^CHILD_ERROR_NATIVE */ - if (strEQ(name2, "HILD_ERROR_NATIVE")) + if (memEQs(name, len, "\003HILD_ERROR_NATIVE")) goto magicalize; break; case '\005': /* $^ENCODING */ - if (strEQ(name2, "NCODING")) + if (memEQs(name, len, "\005NCODING")) goto magicalize; break; case '\007': /* $^GLOBAL_PHASE */ - if (strEQ(name2, "LOBAL_PHASE")) + if (memEQs(name, len, "\007LOBAL_PHASE")) goto ro_magicalize; break; case '\014': /* $^LAST_FH */ - if (strEQ(name2, "AST_FH")) + if (memEQs(name, len, "\014AST_FH")) goto ro_magicalize; break; case '\015': /* $^MATCH */ - if (strEQ(name2, "ATCH")) { + if (memEQs(name, len, "\015ATCH")) { paren = RX_BUFF_IDX_CARET_FULLMATCH; goto storeparen; } break; case '\017': /* $^OPEN */ - if (strEQ(name2, "PEN")) + if (memEQs(name, len, "\017PEN")) goto magicalize; break; case '\020': /* $^PREMATCH $^POSTMATCH */ - if (strEQ(name2, "REMATCH")) { + if (memEQs(name, len, "\020REMATCH")) { paren = RX_BUFF_IDX_CARET_PREMATCH; goto storeparen; } - if (strEQ(name2, "OSTMATCH")) { + if (memEQs(name, len, "\020OSTMATCH")) { paren = RX_BUFF_IDX_CARET_POSTMATCH; goto storeparen; } break; case '\024': /* ${^TAINT} */ - if (strEQ(name2, "AINT")) + if (memEQs(name, len, "\024AINT")) goto ro_magicalize; break; case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */ - if (strEQ(name2, "NICODE")) + if (memEQs(name, len, "\025NICODE")) goto ro_magicalize; - if (strEQ(name2, "TF8LOCALE")) + if (memEQs(name, len, "\025TF8LOCALE")) goto ro_magicalize; - if (strEQ(name2, "TF8CACHE")) + if (memEQs(name, len, "\025TF8CACHE")) goto magicalize; break; case '\027': /* $^WARNING_BITS */ - if (strEQ(name2, "ARNING_BITS")) + if (memEQs(name, len, "\027ARNING_BITS")) goto magicalize; #ifdef WIN32 - else if (strEQ(name2, "IN32_SLOPPY_STAT")) + else if (memEQs(name, len, "\027IN32_SLOPPY_STAT")) goto magicalize; #endif break; @@ -2092,13 +2102,13 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); - /* magicalization must be done before require_tie_mod is called */ + /* magicalization must be done before require_tie_mod_s is called */ if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) - require_tie_mod(gv, '!', "Errno", 5, 1); + require_tie_mod_s(gv, '!', "Errno", 1); break; - case '-': /* $- */ - case '+': /* $+ */ + case '-': /* $-, %-, @- */ + case '+': /* $+, %+, @+ */ GvMULTI_on(gv); /* no used once warnings here */ { AV* const av = GvAVn(gv); @@ -2111,7 +2121,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, SvREADONLY_on(av); if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) - require_tie_mod(gv, *name, "Tie::Hash::NamedCapture",23,0); + require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture",0); break; } @@ -2131,7 +2141,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, case '[': /* $[ */ if ((sv_type == SVt_PV || sv_type == SVt_PVGV) && FEATURE_ARYBASE_IS_ENABLED) { - require_tie_mod(gv,'[',"arybase",7,0); + require_tie_mod_s(gv,'[',"arybase",0); } else goto magicalize; break; @@ -2225,9 +2235,9 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type) if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) { if (*name == '!') - require_tie_mod(gv, '!', "Errno", 5, 1); + require_tie_mod_s(gv, '!', "Errno", 1); else if (*name == '-' || *name == '+') - require_tie_mod(gv, *name, "Tie::Hash::NamedCapture", 23, 0); + require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0); } else if (sv_type == SVt_PV) { if (*name == '*' || *name == '#') { /* diag_listed_as: $* is no longer supported */ @@ -2239,7 +2249,7 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type) if (sv_type==SVt_PV || sv_type==SVt_PVGV) { switch (*name) { case '[': - require_tie_mod(gv,'[',"arybase",7,0); + require_tie_mod_s(gv,'[',"arybase",0); break; #ifdef PERL_SAWAMPERSAND case '`': @@ -2330,7 +2340,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, maybe_multimagic_gv(gv, name, sv_type); } else if (len == 3 && sv_type == SVt_PVAV - && strnEQ(name, "ISA", 3) + && strEQs(name, "ISA") && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv)))) gv_magicalize_isa(gv); } diff --git a/handy.h b/handy.h index 11009d3..5e31d1e 100644 --- a/handy.h +++ b/handy.h @@ -417,14 +417,7 @@ a string/length pair. Perl_gv_fetchpvn_flags(aTHX_ namebeg, len, add, sv_type) #define sv_catxmlpvs(dsv, str, utf8) \ Perl_sv_catxmlpvn(aTHX_ dsv, STR_WITH_LEN(str), utf8) -#define hv_fetchs(hv,key,lval) \ - ((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \ - (lval) ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, NULL, 0)) -#define hv_stores(hv,key,val) \ - ((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), 0)) #define lex_stuff_pvs(pv,flags) Perl_lex_stuff_pvn(aTHX_ STR_WITH_LEN(pv), flags) @@ -481,15 +474,20 @@ Returns zero if non-equal, or non-zero if equal. =cut */ + #define strNE(s1,s2) (strcmp(s1,s2)) #define strEQ(s1,s2) (!strcmp(s1,s2)) #define strLT(s1,s2) (strcmp(s1,s2) < 0) #define strLE(s1,s2) (strcmp(s1,s2) <= 0) #define strGT(s1,s2) (strcmp(s1,s2) > 0) #define strGE(s1,s2) (strcmp(s1,s2) >= 0) + #define strnNE(s1,s2,l) (strncmp(s1,s2,l)) #define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) +#define strNEs(s1,s2) (strncmp(s1,"" s2 "", sizeof(s2)-1)) +#define strEQs(s1,s2) (!strncmp(s1,"" s2 "", sizeof(s2)-1)) + #ifdef HAS_MEMCMP # define memNE(s1,s2,l) (memcmp(s1,s2,l)) # define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) @@ -500,9 +498,15 @@ Returns zero if non-equal, or non-zero if equal. /* memEQ and memNE where second comparand is a string constant */ #define memEQs(s1, l, s2) \ - (sizeof(s2)-1 == l && memEQ(s1, ("" s2 ""), (sizeof(s2)-1))) + (((sizeof(s2)-1) == (l)) && memEQ((s1), ("" s2 ""), (sizeof(s2)-1))) #define memNEs(s1, l, s2) !memEQs(s1, l, s2) +/* memEQ and memNE where second comparand is a string constant + * and we can assume the length of s1 is at least that of the string */ +#define _memEQs(s1, s2) \ + (memEQ((s1), ("" s2 ""), (sizeof(s2)-1))) +#define _memNEs(s1, s2) (memNE((s1),("" s2 ""),(sizeof(s2)-1))) + #define memLT(s1,s2,l) (memcmp(s1,s2,l) < 0) #define memLE(s1,s2,l) (memcmp(s1,s2,l) <= 0) #define memGT(s1,s2,l) (memcmp(s1,s2,l) > 0) diff --git a/hv.c b/hv.c index ad7802c..7d9579c 100644 --- a/hv.c +++ b/hv.c @@ -1199,7 +1199,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, sv_2mortal((SV *)gv) ); } - else if (klen == 3 && strnEQ(key, "ISA", 3) && GvAV(gv)) { + else if (klen == 3 && strEQs(key, "ISA") && GvAV(gv)) { AV *isa = GvAV(gv); MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa); diff --git a/hv.h b/hv.h index 0e773f2..ee536f0 100644 --- a/hv.h +++ b/hv.h @@ -475,6 +475,8 @@ C<SV*>. (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ (val), (hash))) + + #define hv_exists(hv, key, klen) \ (hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0) \ ? TRUE : FALSE) @@ -488,6 +490,24 @@ C<SV*>. (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \ (flags) | HV_DELETE, NULL, 0))) +/* Provide 's' suffix subs for constant strings (and avoid needing to count + * chars). See STR_WITH_LEN in handy.h - because these are macros we cant use + * STR_WITH_LEN to do the work, we have to unroll it. */ +#define hv_existss(hv, key) \ + hv_exists((hv), ("" key ""), (sizeof(key)-1)) + +#define hv_fetchs(hv, key, lval) \ + hv_fetch((hv), ("" key ""), (sizeof(key)-1), (lval)) + +#define hv_deletes(hv, key, flags) \ + hv_delete((hv), ("" key ""), (sizeof(key)-1), (flags)) + +#define hv_name_sets(hv, name, flags) \ + hv_name_set((hv),("" name ""),(sizeof(name)-1), flags) + +#define hv_stores(hv, key, val) \ + hv_store((hv), ("" key ""), (sizeof(key)-1), (val), 0) + #ifdef PERL_CORE # define hv_storehek(hv, hek, val) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ diff --git a/lib/unicore/mktables b/lib/unicore/mktables index d81fc63..e93cb4d 100644 --- a/lib/unicore/mktables +++ b/lib/unicore/mktables @@ -18620,6 +18620,21 @@ sub make_property_test_script() { # or multiple lines. main::write doesn't count the lines. my @output; + push @output, <<'EOF_CODE'; +Error('\p{Script=InGreek}'); # Bug #69018 +Test_GCB("1100 $nobreak 1161"); # Bug #70940 +Expect(0, 0x2028, '\p{Print}', ""); # Bug # 71722 +Expect(0, 0x2029, '\p{Print}', ""); # Bug # 71722 +Expect(1, 0xFF10, '\p{XDigit}', ""); # Bug # 71726 + +# Make sure this gets tested; it was not part of the official test suite at +# the time this was added. Note that this is as it would appear in the +# official suite, and gets modified to check for the perl tailoring by +# Test_WB() +Test_WB("$breakable 0020 $breakable 0020 $breakable 0308 $breakable"); +Test_LB("$nobreak 200B $nobreak 0020 $nobreak 0020 $breakable 2060 $breakable"); +EOF_CODE + # Sort these so get results in same order on different runs of this # program foreach my $property (sort { $a->has_dependency <=> $b->has_dependency @@ -18808,17 +18823,38 @@ sub make_property_test_script() { ? "\nsub TODO_FAILING_BREAKS { 1 }\n" : "\nsub TODO_FAILING_BREAKS { 0 }\n"; + + push @output, + (map {"Test_GCB('$_');\n"} @backslash_X_tests), + (map {"Test_LB('$_');\n"} @LB_tests), + (map {"Test_SB('$_');\n"} @SB_tests), + (map {"Test_WB('$_');\n"} @WB_tests); + + @output= map { + map s/^/ /mgr, + map "$_;\n", + split /;\n/, $_ + } @output; + + my @output_chunked; + my $chunk_count=0; + my $chunk_size= int(@output/10)+1; + while (@output) { + $chunk_count++; + my @chunk= splice @output, 0, $chunk_size; + push @output_chunked, + "if (!\$::TESTCHUNK or \$::TESTCHUNK == $chunk_count){\n", + @chunk, + "}\n"; + } + &write($t_path, 0, # Not utf8; [$HEADER, $TODO_FAILING_BREAKS, <DATA>, - @output, - (map {"Test_GCB('$_');\n"} @backslash_X_tests), - (map {"Test_LB('$_');\n"} @LB_tests), - (map {"Test_SB('$_');\n"} @SB_tests), - (map {"Test_WB('$_');\n"} @WB_tests), - "Finished();\n" + @output_chunked, + "Finished();\n", ]); return; @@ -20152,15 +20188,3 @@ sub Finished() { exit($Fails ? -1 : 0); } -Error('\p{Script=InGreek}'); # Bug #69018 -Test_GCB("1100 $nobreak 1161"); # Bug #70940 -Expect(0, 0x2028, '\p{Print}', ""); # Bug # 71722 -Expect(0, 0x2029, '\p{Print}', ""); # Bug # 71722 -Expect(1, 0xFF10, '\p{XDigit}', ""); # Bug # 71726 - -# Make sure this gets tested; it was not part of the official test suite at -# the time this was added. Note that this is as it would appear in the -# official suite, and gets modified to check for the perl tailoring by -# Test_WB() -Test_WB("$breakable 0020 $breakable 0020 $breakable 0308 $breakable"); -Test_LB("$nobreak 200B $nobreak 0020 $nobreak 0020 $breakable 2060 $breakable"); diff --git a/locale.c b/locale.c index 92b9e33..d042587 100644 --- a/locale.c +++ b/locale.c @@ -1213,8 +1213,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn) { char **e; for (e = environ; *e; e++) { - if (strnEQ(*e, "LC_", 3) - && strnNE(*e, "LC_ALL=", 7) + if (strEQs(*e, "LC_") + && strNEs(*e, "LC_ALL=") && (p = strchr(*e, '='))) PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n", (int)(p - *e), *e, p + 1); diff --git a/mg.c b/mg.c index 863b5fc..238d847 100644 --- a/mg.c +++ b/mg.c @@ -714,7 +714,7 @@ Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv) if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT))) sv_setsv(sv, &PL_sv_undef); else { - sv_setpvs(sv, ""); + SvPVCLEAR(sv); SvUTF8_off(sv); if ((CopHINTS_get(c) & HINT_LEXICAL_IO_IN)) { SV *const value = cop_hints_fetch_pvs(c, "open<", 0); @@ -829,7 +829,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1) sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length); else - sv_setpvs(sv,""); + SvPVCLEAR(sv); } #elif defined(OS2) if (!(_emx_env & 0x200)) { /* Under DOS */ @@ -856,7 +856,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) fixup_errno_string(sv); } else - sv_setpvs(sv, ""); + SvPVCLEAR(sv); SetLastError(dwErr); } # else @@ -882,7 +882,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) else #endif if (! errno) { - sv_setpvs(sv, ""); + SvPVCLEAR(sv); } else { @@ -1179,7 +1179,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) if (TAINTING_get) { MgTAINTEDDIR_off(mg); #ifdef VMS - if (s && klen == 8 && strEQ(key, "DCL$PATH")) { + if (s && memEQs(key, klen, "DCL$PATH")) { char pathbuf[256], eltbuf[256], *cp, *elt; int i = 0, j = 0; @@ -1205,7 +1205,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf)); } #endif /* VMS */ - if (s && klen == 4 && strEQ(key,"PATH")) { + if (s && memEQs(key, klen, "PATH")) { const char * const strend = s + len; /* set MGf_TAINTEDDIR if any component of the new path is diff --git a/mro_core.c b/mro_core.c index d4ca7f2..809bcdf 100644 --- a/mro_core.c +++ b/mro_core.c @@ -346,7 +346,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) /* They have no stash. So create ourselves an ->isa cache as if we'd copied it from what theirs should be. */ stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); - (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0); + (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); av_push(retval, newSVhek(HeKEY_hek(hv_store_ent(stored, sv, &PL_sv_undef, 0)))); @@ -356,7 +356,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) } else { /* We have no parents. */ stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); - (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0); + (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); } (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0); @@ -451,7 +451,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) HEK_LEN(canon_name), HEK_FLAGS(canon_name), HV_FETCH_ISSTORE, &PL_sv_undef, HEK_HASH(canon_name)); - (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0); + (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef); SvREADONLY_on(isa_hash); @@ -524,8 +524,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) svp = hv_fetchhek(PL_isarev, stashhek, 0); isarev = svp ? MUTABLE_HV(*svp) : NULL; - if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL")) - || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) { + if((memEQs(stashname, stashname_len, "UNIVERSAL")) + || (isarev && hv_existss(isarev, "UNIVERSAL"))) { PL_sub_generation++; is_universal = TRUE; } @@ -1329,8 +1329,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ - if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL")) - || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) { + if((memEQs(stashname, stashname_len, "UNIVERSAL")) + || (isarev && hv_existss(isarev, "UNIVERSAL"))) { PL_sub_generation++; return; } diff --git a/numeric.c b/numeric.c index 7e05966..6ea6968 100644 --- a/numeric.c +++ b/numeric.c @@ -1013,7 +1013,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags) s++; if (s >= send) return numtype; - if (len == 10 && memEQ(pv, "0 but true", 10)) { + if (len == 10 && _memEQs(pv, "0 but true")) { if (valuep) *valuep = 0; return IS_NUMBER_IN_UV; diff --git a/op.c b/op.c index 34c9a60..ebbbf81 100644 --- a/op.c +++ b/op.c @@ -8205,7 +8205,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) CvSTASH_set(cv, PL_curstash); *spot = cv; } - sv_setpvs(MUTABLE_SV(cv), ""); /* prototype is "" */ + SvPVCLEAR(MUTABLE_SV(cv)); /* prototype is "" */ CvXSUBANY(cv).any_ptr = const_sv; CvXSUB(cv) = const_sv_xsub; CvCONST_on(cv); @@ -8657,7 +8657,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, if (cv) { assert(!CvROOT(cv) && !CvCONST(cv)); cv_forget_slab(cv); - sv_setpvs(MUTABLE_SV(cv), ""); /* prototype is "" */ + SvPVCLEAR(MUTABLE_SV(cv)); /* prototype is "" */ CvXSUBANY(cv).any_ptr = const_sv; CvXSUB(cv) = const_sv_xsub; CvCONST_on(cv); @@ -10162,7 +10162,7 @@ Perl_ck_fun(pTHX_ OP *o) if (want_dollar && *name != '$') sv_setpvs(namesv, "$"); else - sv_setpvs(namesv, ""); + SvPVCLEAR(namesv); sv_catpvn(namesv, name, len); if ( name_utf8 ) SvUTF8_on(namesv); } diff --git a/os2/OS2/OS2-REXX/DLL/DLL.xs b/os2/OS2/OS2-REXX/DLL/DLL.xs index 56194bd..f9fcef8 100644 --- a/os2/OS2/OS2-REXX/DLL/DLL.xs +++ b/os2/OS2/OS2-REXX/DLL/DLL.xs @@ -164,7 +164,7 @@ _call(name, address, queue="SESSION", ...) if (result.strptr) sv_setpvn(ST(0), result.strptr, result.strlength); else - sv_setpvs(ST(0), ""); + SvPVCLEAR(ST(0)); } if (result.strptr && result.strptr != resbuf) DosFreeMem(result.strptr); diff --git a/os2/os2.c b/os2/os2.c index 91daa81..d7a4b58 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -1171,11 +1171,11 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) if (buf[1] == '!') s = buf + 2; } else if (buf[0] == 'e') { - if (strnEQ(buf, "extproc", 7) + if (strEQs(buf, "extproc") && isSPACE(buf[7])) s = buf + 8; } else if (buf[0] == 'E') { - if (strnEQ(buf, "EXTPROC", 7) + if (strEQs(buf, "EXTPROC") && isSPACE(buf[7])) s = buf + 8; } @@ -1372,7 +1372,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) while (*cmd && isSPACE(*cmd)) cmd++; - if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) { + if (strEQs(cmd,"/bin/sh") && isSPACE(cmd[7])) { STRLEN l = strlen(PL_sh_path); Newx(news, strlen(cmd) - 7 + l + 1, char); @@ -1387,7 +1387,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) if (*cmd == '.' && isSPACE(cmd[1])) goto doshell; - if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) + if (strEQs(cmd,"exec") && isSPACE(cmd[4])) goto doshell; for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */ @@ -2632,7 +2632,7 @@ XS(XS_OS2_Errors2Drive) if (DOS_suppression_state > 0) sv_setpvn(ST(0), &DOS_suppression_state, 1); else if (DOS_suppression_state == 0) - sv_setpvs(ST(0), ""); + SvPVCLEAR(ST(0)); DOS_suppression_state = drive; } XSRETURN(1); @@ -4103,7 +4103,7 @@ XS(XS_OS2_pipe) if (!pszName || !*pszName) Perl_croak(aTHX_ "OS2::pipe(): empty pipe name"); s = SvPV(OpenMode, len); - if (len == 4 && strEQ(s, "wait")) { /* DosWaitNPipe() */ + if (memEQs(s, len, "wait")) { /* DosWaitNPipe() */ ULONG ms = 0xFFFFFFFF, ret = ERROR_INTERRUPT; /* Indefinite */ if (items == 3) { @@ -4121,7 +4121,7 @@ XS(XS_OS2_pipe) os2cp_croak(ret, "DosWaitNPipe()"); XSRETURN_YES; } - if (len == 4 && strEQ(s, "call")) { /* DosCallNPipe() */ + if (memEQs(s, len, "call")) { /* DosCallNPipe() */ ULONG ms = 0xFFFFFFFF, got; /* Indefinite */ STRLEN l; char *s; @@ -4200,9 +4200,9 @@ XS(XS_OS2_pipe) connect = -1; /* no wait */ else if (SvTRUE(ST(2))) { s = SvPV(ST(2), len); - if (len == 6 && strEQ(s, "nowait")) + if (memEQs(s, len, "nowait")) connect = -1; /* no wait */ - else if (len == 4 && strEQ(s, "wait")) + else if (memEQs(s, len, "wait")) connect = 1; /* wait */ else Perl_croak(aTHX_ "OS2::pipe(): unknown connect argument: `%s'", s); diff --git a/perl.c b/perl.c index ba6d5af..aa7d8b6 100644 --- a/perl.c +++ b/perl.c @@ -295,9 +295,9 @@ perl_construct(pTHXx) PL_fdpid = newAV(); /* for remembering popen pids by fd */ PL_modglobal = newHV(); /* pointers to per-interpreter module globals */ PL_errors = newSVpvs(""); - sv_setpvs(PERL_DEBUG_PAD(0), ""); /* For regex debugging. */ - sv_setpvs(PERL_DEBUG_PAD(1), ""); /* ext/re needs these */ - sv_setpvs(PERL_DEBUG_PAD(2), ""); /* even without DEBUGGING. */ + SvPVCLEAR(PERL_DEBUG_PAD(0)); /* For regex debugging. */ + SvPVCLEAR(PERL_DEBUG_PAD(1)); /* ext/re needs these */ + SvPVCLEAR(PERL_DEBUG_PAD(2)); /* even without DEBUGGING. */ #ifdef USE_ITHREADS /* First entry is a list of empty elements. It needs to be initialised else all hell breaks loose in S_find_uninit_var(). */ @@ -1139,7 +1139,7 @@ perl_destruct(pTHXx) hv = PL_defstash; /* break ref loop *:: <=> %:: */ - (void)hv_delete(hv, "main::", 6, G_DISCARD); + (void)hv_deletes(hv, "main::", G_DISCARD); PL_defstash = 0; SvREFCNT_dec(hv); SvREFCNT_dec(PL_curstname); @@ -3730,7 +3730,7 @@ S_init_main_stash(pTHX) because otherwise all we do is delete "main" from it as a consequence of the SvREFCNT_dec, only to add it again with hv_name_set */ SvREFCNT_dec(GvHV(gv)); - hv_name_set(PL_defstash, "main", 4, 0); + hv_name_sets(PL_defstash, "main", 0); GvHV(gv) = MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); SvREADONLY_on(gv); PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL, @@ -3782,7 +3782,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) /* if find_script() returns, it returns a malloc()-ed value */ scriptname = PL_origfilename = find_script(scriptname, dosearch, NULL, 1); - if (strnEQ(scriptname, "/dev/fd/", 8) + if (strEQs(scriptname, "/dev/fd/") && isDIGIT(scriptname[8]) && grok_atoUV(scriptname + 8, &uv, &s) && uv <= PERL_INT_MAX @@ -3963,7 +3963,7 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) if (*s++ == '-') { while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.' || s2[-1] == '_') s2--; - if (strnEQ(s2-4,"perl",4)) + if (strEQs(s2-4,"perl")) while ((s = moreswitches(s))) ; } @@ -4345,9 +4345,9 @@ S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env) PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS; PL_toptarget = newSV_type(SVt_PVIV); - sv_setpvs(PL_toptarget, ""); + SvPVCLEAR(PL_toptarget); PL_bodytarget = newSV_type(SVt_PVIV); - sv_setpvs(PL_bodytarget, ""); + SvPVCLEAR(PL_bodytarget); PL_formtarget = PL_bodytarget; TAINT; @@ -4777,7 +4777,7 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) if (lastslash) { SV *tempsv; while ((*lastslash = '\0'), /* Do that, come what may. */ - (libpath_len >= 3 && memEQ(libpath, "../", 3) + (libpath_len >= 3 && _memEQs(libpath, "../") && (lastslash = strrchr(prefix, '/')))) { if (lastslash[1] == '\0' || (lastslash[1] == '.' diff --git a/perl.h b/perl.h index 8444bc0..a843a60 100644 --- a/perl.h +++ b/perl.h @@ -1277,7 +1277,7 @@ EXTERN_C char *crypt(const char *, const char *); *svp = newSVpvs(""); \ } else { \ SV *const errsv = *svp; \ - sv_setpvs(errsv, ""); \ + SvPVCLEAR(errsv); \ SvPOK_only(errsv); \ if (SvMAGICAL(errsv)) { \ mg_free(errsv); \ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 576a41c..a6aba00 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -186,7 +186,7 @@ sv_insert() or sv_insert_flags(). If you don't need the existing content of the SV, you can avoid some copying with: - sv_setpvs(sv, ""); + SvPVCLEAR(sv); s = SvGROW(sv, needlen + 1); /* something that modifies up to needlen bytes at s, but modifies newlen bytes diff --git a/pod/perlhacktut.pod b/pod/perlhacktut.pod index 4143ec3..72919fc 100644 --- a/pod/perlhacktut.pod +++ b/pod/perlhacktut.pod @@ -74,7 +74,7 @@ of C<pat>: items = SP - MARK; MARK++; - sv_setpvs(cat, ""); + SvPVCLEAR(cat); + patcopy = pat; while (pat < patend) { diff --git a/pp.c b/pp.c index 00a577e..ebb17d1 100644 --- a/pp.c +++ b/pp.c @@ -658,10 +658,9 @@ PP(pp_gelem) sv = NULL; if (elem) { /* elem will always be NUL terminated. */ - const char * const second_letter = elem + 1; switch (*elem) { case 'A': - if (len == 5 && strEQ(second_letter, "RRAY")) + if (memEQs(elem, len, "ARRAY")) { tmpRef = MUTABLE_SV(GvAV(gv)); if (tmpRef && !AvREAL((const AV *)tmpRef) @@ -670,42 +669,42 @@ PP(pp_gelem) } break; case 'C': - if (len == 4 && strEQ(second_letter, "ODE")) + if (memEQs(elem, len, "CODE")) tmpRef = MUTABLE_SV(GvCVu(gv)); break; case 'F': - if (len == 10 && strEQ(second_letter, "ILEHANDLE")) { + if (memEQs(elem, len, "FILEHANDLE")) { tmpRef = MUTABLE_SV(GvIOp(gv)); } else - if (len == 6 && strEQ(second_letter, "ORMAT")) + if (memEQs(elem, len, "FORMAT")) tmpRef = MUTABLE_SV(GvFORM(gv)); break; case 'G': - if (len == 4 && strEQ(second_letter, "LOB")) + if (memEQs(elem, len, "GLOB")) tmpRef = MUTABLE_SV(gv); break; case 'H': - if (len == 4 && strEQ(second_letter, "ASH")) + if (memEQs(elem, len, "HASH")) tmpRef = MUTABLE_SV(GvHV(gv)); break; case 'I': - if (*second_letter == 'O' && !elem[2] && len == 2) + if (memEQs(elem, len, "IO")) tmpRef = MUTABLE_SV(GvIOp(gv)); break; case 'N': - if (len == 4 && strEQ(second_letter, "AME")) + if (memEQs(elem, len, "NAME")) sv = newSVhek(GvNAME_HEK(gv)); break; case 'P': - if (len == 7 && strEQ(second_letter, "ACKAGE")) { + if (memEQs(elem, len, "PACKAGE")) { const HV * const stash = GvSTASH(gv); const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL; sv = hek ? newSVhek(hek) : newSVpvs("__ANON__"); } break; case 'S': - if (len == 6 && strEQ(second_letter, "CALAR")) + if (memEQs(elem, len, "SCALAR")) tmpRef = GvSVn(gv); break; } @@ -902,7 +901,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping) } } else - sv_setpvs(retval, ""); + SvPVCLEAR(retval); } else if (s && len) { s += --len; @@ -913,7 +912,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping) SvNIOK_off(sv); } else - sv_setpvs(retval, ""); + SvPVCLEAR(retval); SvSETMAGIC(sv); } return count; @@ -3448,7 +3447,7 @@ PP(pp_substr) repl = SvPV_const(repl_sv_copy, repl_len); } if (!SvOK(sv)) - sv_setpvs(sv, ""); + SvPVCLEAR(sv); sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0); SvREFCNT_dec(repl_sv_copy); } diff --git a/pp_ctl.c b/pp_ctl.c index 36b68b6..87c669d 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1139,7 +1139,7 @@ PP(pp_flip) RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); } } - sv_setpvs(TARG, ""); + SvPVCLEAR(TARG); SETs(targ); RETURN; } diff --git a/pp_hot.c b/pp_hot.c index ee908c5..ab59096 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -289,7 +289,7 @@ PP(pp_concat) && ckWARN(WARN_UNINITIALIZED) ) report_uninit(left); - sv_setpvs(left, ""); + SvPVCLEAR(left); } else { SvPV_force_nomg_nolen(left); diff --git a/pp_pack.c b/pp_pack.c index 40c3100..7e6dc4d 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -3125,7 +3125,7 @@ PP(pp_pack) const char *patend = pat + fromlen; MARK++; - sv_setpvs(cat, ""); + SvPVCLEAR(cat); SvUTF8_off(cat); packlist(cat, pat, patend, MARK, SP + 1); diff --git a/pp_sys.c b/pp_sys.c index 3c8e985..13f2913 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -320,7 +320,7 @@ PP(pp_backtick) ENTER_with_name("backtick"); SAVESPTR(PL_rs); PL_rs = &PL_sv_undef; - sv_setpvs(TARG, ""); /* note that this preserves previous buffer */ + SvPVCLEAR(TARG); /* note that this preserves previous buffer */ while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL) NOOP; LEAVE_with_name("backtick"); @@ -1684,7 +1684,7 @@ PP(pp_sysread) goto say_undef; bufsv = *++MARK; if (! SvOK(bufsv)) - sv_setpvs(bufsv, ""); + SvPVCLEAR(bufsv); length = SvIVx(*++MARK); if (length < 0) DIE(aTHX_ "Negative length"); @@ -2895,7 +2895,7 @@ PP(pp_stat) havefp = FALSE; PL_laststype = OP_STAT; PL_statgv = gv ? gv : (GV *)io; - sv_setpvs(PL_statname, ""); + SvPVCLEAR(PL_statname); if(gv) { io = GvIO(gv); } @@ -3455,7 +3455,7 @@ PP(pp_fttext) } else { PL_statgv = gv; - sv_setpvs(PL_statname, ""); + SvPVCLEAR(PL_statname); io = GvIO(PL_statgv); } PL_laststatval = -1; diff --git a/proto.h b/proto.h index 701dc9e..228e84e 100644 --- a/proto.h +++ b/proto.h @@ -3251,6 +3251,9 @@ PERL_CALLCONV void Perl_sv_setnv_mg(pTHX_ SV *const sv, const NV num); PERL_CALLCONV void Perl_sv_setpv(pTHX_ SV *const sv, const char *const ptr); #define PERL_ARGS_ASSERT_SV_SETPV \ assert(sv) +PERL_CALLCONV char * Perl_sv_setpv_bufsize(pTHX_ SV *const sv, const STRLEN cur, const STRLEN len); +#define PERL_ARGS_ASSERT_SV_SETPV_BUFSIZE \ + assert(sv) PERL_CALLCONV void Perl_sv_setpv_mg(pTHX_ SV *const sv, const char *const ptr); #define PERL_ARGS_ASSERT_SV_SETPV_MG \ assert(sv) diff --git a/regcharclass.h b/regcharclass.h index 6f5d14b..09857a7 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -1873,7 +1873,7 @@ * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 lib/unicore/extracted/DLineBreak.txt * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 lib/unicore/extracted/DNumType.txt * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 lib/unicore/extracted/DNumValues.txt - * 5c7eb94310e2aaa15702fd6bed24ff0e7ab5448f9a8231d8c49ca96c9e941089 lib/unicore/mktables + * 421444fcd83fcdfecffa743c8888c3a1a8e88bcde472a80fca57d199ec5db10a lib/unicore/mktables * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl * 66e20f857451956f9fc7ad7432de972e84fb857885009838878bcf6f91ffbeef regen/regcharclass.pl diff --git a/regcomp.c b/regcomp.c index 634a320..68417ff 100644 --- a/regcomp.c +++ b/regcomp.c @@ -18893,7 +18893,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ PERL_ARGS_ASSERT_REGPROP; - sv_setpvs(sv, ""); + SvPVCLEAR(sv); if (OP(o) > REGNODE_MAX) /* regnode.type is unsigned */ /* It would be nice to FAIL() here, but this may be called from @@ -20536,7 +20536,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, #endif const regnode *nextbranch= NULL; I32 word_idx; - sv_setpvs(sv, ""); + SvPVCLEAR(sv); for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { SV ** const elem_ptr = av_fetch(trie_words,word_idx,0); diff --git a/sv.c b/sv.c index dd0b3d4..dc0ef5c 100644 --- a/sv.c +++ b/sv.c @@ -4875,6 +4875,35 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) #endif /* +=for apidoc sv_setpv_bufsize + +Sets the SV to be a string of cur bytes length, with at least +len bytes available. Ensures that there is a null byte at SvEND. +Returns a char * pointer to the SvPV buffer. + +=cut +*/ + +char * +Perl_sv_setpv_bufsize(pTHX_ SV *const sv, const STRLEN cur, const STRLEN len) +{ + char *pv; + + PERL_ARGS_ASSERT_SV_SETPV_BUFSIZE; + + SV_CHECK_THINKFIRST_COW_DROP(sv); + SvUPGRADE(sv, SVt_PV); + pv = SvGROW(sv, len + 1); + SvCUR_set(sv, cur); + *(SvEND(sv))= '\0'; + (void)SvPOK_only_UTF8(sv); /* validate pointer */ + + SvTAINT(sv); + if (SvTYPE(sv) == SVt_PVCV) CvAUTOLOAD_off(sv); + return pv; +} + +/* =for apidoc sv_setpvn Copies a string (possibly containing embedded C<NUL> characters) into an SV. @@ -10822,7 +10851,7 @@ Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, { PERL_ARGS_ASSERT_SV_VSETPVFN; - sv_setpvs(sv, ""); + SvPVCLEAR(sv); sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, 0); } @@ -11765,7 +11794,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p * vectorize happen normally */ if (sv_isobject(vecsv) && sv_derived_from(vecsv, "version")) { - if ( hv_exists(MUTABLE_HV(SvRV(vecsv)), "alpha", 5 ) ) { + if ( hv_existss(MUTABLE_HV(SvRV(vecsv)), "alpha") ) { Perl_ck_warner_d(aTHX_ packWARN(WARN_PRINTF), "vector argument not supported with alpha versions"); goto vdblank; @@ -15045,9 +15074,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* magical thingies */ - sv_setpvs(PERL_DEBUG_PAD(0), ""); /* For regex debugging. */ - sv_setpvs(PERL_DEBUG_PAD(1), ""); /* ext/re needs these */ - sv_setpvs(PERL_DEBUG_PAD(2), ""); /* even without DEBUGGING. */ + SvPVCLEAR(PERL_DEBUG_PAD(0)); /* For regex debugging. */ + SvPVCLEAR(PERL_DEBUG_PAD(1)); /* ext/re needs these */ + SvPVCLEAR(PERL_DEBUG_PAD(2)); /* even without DEBUGGING. */ /* Clone the regex array */ diff --git a/sv.h b/sv.h index 7f43f3b..d45a4a9 100644 --- a/sv.h +++ b/sv.h @@ -2035,9 +2035,14 @@ Returns a pointer to the character buffer. SV must be of type >= C<SVt_PV>. One alternative is to call C<sv_grow> if you are not sure of the type of SV. +=for apidoc Am|char *|SvPVCLEAR|SV* sv +Ensures that sv is a SVt_PV and that its SvCUR is 0, and that it is +properly null terminated. Equivalent to sv_setpvs(""), but more efficient. + =cut */ +#define SvPVCLEAR(sv) sv_setpv_bufsize(sv,0,0) #define SvSHARE(sv) PL_sharehook(aTHX_ sv) #define SvLOCK(sv) PL_lockhook(aTHX_ sv) #define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv) diff --git a/t/re/uniprops.t b/t/re/uniprops01.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops01.t index 5214c41..4b4231c 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops01.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=1; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops02.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops02.t index 5214c41..8895ae9 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops02.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=2; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops03.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops03.t index 5214c41..c866407 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops03.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=3; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops04.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops04.t index 5214c41..7689df0 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops04.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=4; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops05.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops05.t index 5214c41..0573377 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops05.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=5; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops06.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops06.t index 5214c41..74e6c45 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops06.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=6; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops07.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops07.t index 5214c41..fe67954 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops07.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=7; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops08.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops08.t index 5214c41..a9b412a 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops08.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=8; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops09.t similarity index 98% copy from t/re/uniprops.t copy to t/re/uniprops09.t index 5214c41..c9b469b 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops09.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=9; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/t/re/uniprops.t b/t/re/uniprops10.t similarity index 98% rename from t/re/uniprops.t rename to t/re/uniprops10.t index 5214c41..0d0e1ed 100644 --- a/t/re/uniprops.t +++ b/t/re/uniprops10.t @@ -23,6 +23,7 @@ if ($Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DEBUG_READONLY_COW\b/) { exit; } +$::TESTCHUNK=10; do '../lib/unicore/TestProp.pl'; # Since TestProp.pl explicitly exits, we will only get here if it diff --git a/toke.c b/toke.c index c721575..abf80d2 100644 --- a/toke.c +++ b/toke.c @@ -1313,7 +1313,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags) got_some = 0; } else { if (!SvPOK(linestr)) /* can get undefined by filter_gets */ - sv_setpvs(linestr, ""); + SvPVCLEAR(linestr); eof: /* End of real input. Close filehandle (unless it was STDIN), * then add implicit termination. @@ -1679,7 +1679,7 @@ S_incline(pTHX_ const char *s) return; while (SPACE_OR_TAB(*s)) s++; - if (strnEQ(s, "line", 4)) + if (strEQs(s, "line")) s += 4; else return; @@ -1790,7 +1790,7 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len) sv = *av_fetch(av, 0, 1); SvUPGRADE(sv, SVt_PVMG); } - if (!SvPOK(sv)) sv_setpvs(sv,""); + if (!SvPOK(sv)) SvPVCLEAR(sv); if (orig_sv) sv_catsv(sv, orig_sv); else @@ -2037,7 +2037,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) if (check_keyword) { char *s2 = PL_tokenbuf; STRLEN len2 = len; - if (allow_pack && len > 6 && strnEQ(s2, "CORE::", 6)) + if (allow_pack && len > 6 && strEQs(s2, "CORE::")) s2 += 6, len2 -= 6; if (keyword(s2, len2, 0)) return start; @@ -4954,7 +4954,7 @@ Perl_yylex(pTHX) } PL_parser->preambling = CopLINE(PL_curcop); } else - sv_setpvs(PL_linestr,""); + SvPVCLEAR(PL_linestr); if (PL_preambleav) { SV **svp = AvARRAY(PL_preambleav); SV **const end = svp + AvFILLp(PL_preambleav); @@ -5046,8 +5046,8 @@ Perl_yylex(pTHX) } if (PL_parser->in_pod) { /* Incest with pod. */ - if (*s == '=' && strnEQ(s, "=cut", 4) && !isALPHA(s[4])) { - sv_setpvs(PL_linestr, ""); + if (*s == '=' && strEQs(s, "=cut") && !isALPHA(s[4])) { + SvPVCLEAR(PL_linestr); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); **** PATCH TRUNCATED AT 2000 LINES -- 234 NOT SHOWN **** -- Perl5 Master Repository
