Reduce malloc&free for S_parse_gv_stash_name #15689
Comments
From @atoomicCreated by @atoomicThis is a minor improvement by reducing the number of malloc&free Perl Info |
From @tonycozOn Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
Could you attach the patch please? Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @atoomicOn Mon Oct 31 15:56:32 2016, tonyc wrote:
Sorry here is the attached file |
From @atoomic0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patchFrom 113dcb98aa6605d144b6fdb0ff34fcecc63ddc72 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 09:55:05 -0600
Subject: [PATCH 1/1] Reduce malloc&free for S_parse_gv_stash_name
S_parse_gv_stash_name was using multiple malloc
and free when using ' as package separator.
We can malloc & free only once the tmpbuffer as we know the size max.
This is also sligthly improving iterations when using ::
as we do not need to check if we need to free the tmp buffer.
This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check.
---
gv.c | 26 ++++++++++++++------------
1 file changed, 14 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index 1cf0d8d..ee48749 100644
--- a/gv.c
+++ b/gv.c
@@ -1587,6 +1587,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
+ char *tmpbuf = NULL;
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
@@ -1616,9 +1617,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
key = *name;
*len += 2;
}
- else {
- char *tmpbuf;
- Newx(tmpbuf, *len+2, char);
+ else { /* using ' for package separator */
+ if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpbuf, full_len+2, char);
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1626,16 +1627,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
- if (*gv && *gv != (const GV *)&PL_sv_undef) {
- if (SvTYPE(*gv) != SVt_PVGV)
- gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
- else
- GvMULTI_on(*gv);
- }
- if (key != *name)
- Safefree(key);
- if (!*gv || *gv == (const GV *)&PL_sv_undef)
+ if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+ Safefree(tmpbuf);
return FALSE;
+ }
+ /* here we know that *gv && *gv != &PL_sv_undef */
+ if (SvTYPE(*gv) != SVt_PVGV)
+ gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+ else
+ GvMULTI_on(*gv);
if (!(*stash = GvHV(*gv))) {
*stash = GvHV(*gv) = newHV();
@@ -1663,11 +1663,13 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
if (*name == name_end) {
if (!*gv)
*gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+ Safefree(tmpbuf);
return TRUE;
}
}
}
*len = name_cursor - *name;
+ Safefree(tmpbuf);
return TRUE;
}
--
2.10.1
|
From @jkeenanOn Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
How would we measure the improvement? (I'm not a perlguts expert so I can't simply see the improvement by reading the patch.) Thank you very much. -- |
From @tonycozOn Wed, 02 Nov 2016 05:30:36 -0700, jkeenan wrote:
The patch reduces memory allocates when parsing package names where the To measure the difference, build perl without the patch (in separate [ Then run it with bench.pl: $ ./perl -Ilib Porting/bench.pl --benchfile=../129990-bench ../perl2/perl=blead ./perl=blead+patch The numbers represent relative counts per loop iteration, compared to package::simple blead blead+patch COND_m 100.00 112.50 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::quote blead blead+patch COND_m 100.00 203.70 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::colon blead blead+patch COND_m 100.00 102.04 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 AVERAGE blead blead+patch COND_m 100.00 127.13 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 So the patch slightly slows down single component parsing ("Foo"), Tony |
From @atoomicThanks Tony for providing these metrics before I could, The longer the package name is the better should be the improvements On Tue, 08 Nov 2016 16:14:12 -0800, tonyc wrote:
|
From @atoomicThe single package can probably be speed up by avoiding the extra useless Safefree at the end. On Tue, 08 Nov 2016 17:07:15 -0800, atoomic wrote:
|
From @atoomicremoval.patchdiff --git a/gv.c b/gv.c
index 00aeab2..d92c3d3 100644
--- a/gv.c
+++ b/gv.c
@@ -1669,7 +1669,6 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
}
*len = name_cursor - *name;
- Safefree(tmpbuf);
return TRUE;
}
|
From @atoomicHere is an improved patch that solves the single package issue
The numbers represent relative counts per loop iteration, compared to package::simple blead blead+patch COND_m 100.00 - Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::quote blead blead+patch COND_m 100.00 68.03 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::colon blead blead+patch COND_m 100.00 122.22 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 AVERAGE blead blead+patch COND_m 100.00 87.41 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 On Tue, 08 Nov 2016 16:14:12 -0800, tonyc wrote:
|
From @atoomic0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patchFrom 886f1d8b20bafcc9dac9f4d47a5c58157e44d770 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 09:55:05 -0600
Subject: [PATCH 1/1] Reduce malloc&free for S_parse_gv_stash_name
S_parse_gv_stash_name was using multiple malloc
and free when using ' as package separator.
We can malloc & free only once the tmpbuffer as we know the size max.
This is also sligthly improving iterations when using ::
as we do not need to check if we need to free the tmp buffer.
This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check.
---
gv.c | 25 +++++++++++++------------
1 file changed, 13 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index 2dfb364..d92c3d3 100644
--- a/gv.c
+++ b/gv.c
@@ -1587,6 +1587,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
+ char *tmpbuf = NULL;
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
@@ -1616,9 +1617,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
key = *name;
*len += 2;
}
- else {
- char *tmpbuf;
- Newx(tmpbuf, *len+2, char);
+ else { /* using ' for package separator */
+ if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpbuf, full_len+2, char);
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1626,16 +1627,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
- if (*gv && *gv != (const GV *)&PL_sv_undef) {
- if (SvTYPE(*gv) != SVt_PVGV)
- gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
- else
- GvMULTI_on(*gv);
- }
- if (key != *name)
- Safefree(key);
- if (!*gv || *gv == (const GV *)&PL_sv_undef)
+ if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+ Safefree(tmpbuf);
return FALSE;
+ }
+ /* here we know that *gv && *gv != &PL_sv_undef */
+ if (SvTYPE(*gv) != SVt_PVGV)
+ gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+ else
+ GvMULTI_on(*gv);
if (!(*stash = GvHV(*gv))) {
*stash = GvHV(*gv) = newHV();
@@ -1663,6 +1663,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
if (*name == name_end) {
if (!*gv)
*gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+ Safefree(tmpbuf);
return TRUE;
}
}
--
2.10.2
|
From @tonycozOn Sun, 13 Nov 2016 02:41:40 -0800, atoomic wrote:
The improved patch leaks the memory allocated in S_parse_gv_stash_name: tony@mars:.../git/perl$ cat ../129990.pl $x = "xx'yy'foo"; &$x; tony@mars:.../git/perl$ PERL_DESTRUCT_LEVEL=2 valgrind --leak-check=full ./perl ../129990.pl Tony |
From @atoomicIndeed removing the last free lead to a leak. We should then consider the previous patch which is a global improvement IMO, I'm also considering using a small buffer to avoid the malloc in most cases (similar trick than the one used by S_gv_stashpvn_internal ), will probably open another ticket for it, but here is the patch: atoomic@adda0b6 Merging the two ideas might lead to the expected combo. Any thoughts ? On Mon, 14 Nov 2016 21:47:03 -0800, tonyc wrote:
|
From @atoomic0001-add-a-small-buffer-to-gv_stash_name.patchFrom adda0b6b3fadb22090d53d54c4f9d5c77fdf0372 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Thu, 27 Apr 2017 10:45:38 -0600
Subject: [PATCH] add a small buffer to gv_stash_name
---
gv.c | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/gv.c b/gv.c
index d32a9c5..8d69e04 100644
--- a/gv.c
+++ b/gv.c
@@ -1596,6 +1596,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
+ char smallbuf[64]; /* small buffer to avoid a malloc when possible */
PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
@@ -1627,7 +1628,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
else {
char *tmpbuf;
- Newx(tmpbuf, *len+2, char);
+ /* use our pre-allocated buffer when possible to save a malloc */
+ if ( *len+2 <= sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else
+ Newx(tmpbuf, *len+2, char);
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1641,7 +1646,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
else
GvMULTI_on(*gv);
}
- if (key != *name)
+ if (key != *name && key != smallbuf)
Safefree(key);
if (!*gv || *gv == (const GV *)&PL_sv_undef)
return FALSE;
--
2.10.1 (Apple Git-78)
|
From @cpansproutOn Thu, 27 Apr 2017 10:09:36 -0700, atoomic wrote:
Which would require me to change thousands of instances. I would prefer to spend time doing something more productive than that. -- Father Chrysostomos |
From @atoomicAttached are the two patches, and here is a bench using Tony idea + some extra tests. Fetching a gv is so common that I think, even if it s a win of a few percentage, might worth considering them. Not sure to understand the impact on "instances" (what is one instance ? a branch ?) I've used this test. [
The numbers represent relative counts per loop iteration, compared to package::simple blead blead+patch COND_m 100.00 200.00 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::quote blead blead+patch COND_m 100.00 111.11 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::colon blead blead+patch COND_m 100.00 122.22 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 IPC::Open3 blead blead+patch COND_m 100.00 114.29 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 My::Module::Sample::whatever blead blead+patch COND_m 100.00 128.57 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 AVERAGE blead blead+patch COND_m 100.00 129.17 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 On Thu, 27 Apr 2017 10:09:36 -0700, atoomic wrote:
|
From @atoomic0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patchFrom 0910ef454ae69d5166ac2f19cc461cfc5d7417cc Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 09:55:05 -0600
Subject: [PATCH 1/2] Reduce malloc&free for S_parse_gv_stash_name
S_parse_gv_stash_name was using multiple malloc
and free when using ' as package separator.
We can malloc & free only once the tmpbuffer as we know the size max.
This is also sligthly improving iterations when using ::
as we do not need to check if we need to free the tmp buffer.
This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check.
---
gv.c | 25 +++++++++++++------------
1 file changed, 13 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index d32a9c5..a6aefd0 100644
--- a/gv.c
+++ b/gv.c
@@ -1593,6 +1593,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
+ char *tmpbuf = NULL;
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
@@ -1625,9 +1626,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
key = *name;
*len += 2;
}
- else {
- char *tmpbuf;
- Newx(tmpbuf, *len+2, char);
+ else { /* using ' for package separator */
+ if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpbuf, full_len+2, char);
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1635,16 +1636,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
- if (*gv && *gv != (const GV *)&PL_sv_undef) {
- if (SvTYPE(*gv) != SVt_PVGV)
- gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
- else
- GvMULTI_on(*gv);
- }
- if (key != *name)
- Safefree(key);
- if (!*gv || *gv == (const GV *)&PL_sv_undef)
+ if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+ Safefree(tmpbuf);
return FALSE;
+ }
+ /* here we know that *gv && *gv != &PL_sv_undef */
+ if (SvTYPE(*gv) != SVt_PVGV)
+ gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+ else
+ GvMULTI_on(*gv);
if (!(*stash = GvHV(*gv))) {
*stash = GvHV(*gv) = newHV();
@@ -1679,6 +1679,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
}
}
+ Safefree(tmpbuf);
return TRUE;
}
}
--
2.10.1 (Apple Git-78)
|
From @atoomic0002-add-a-small-buffer-to-gv_stash_name.patchFrom 5c9104a24efc546c3e991a0e657b19ec24ab017b Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Thu, 27 Apr 2017 11:29:48 -0600
Subject: [PATCH 2/2] add a small buffer to gv_stash_name
---
gv.c | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/gv.c b/gv.c
index a6aefd0..9dc8771 100644
--- a/gv.c
+++ b/gv.c
@@ -1593,10 +1593,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
- char *tmpbuf = NULL;
+ char *tmpfullbuf = NULL; /* only malloc one big chunk of memory when the smallbuff is not large enough */
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
+ char smallbuf[64]; /* small buffer to avoid a malloc when possible */
PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
@@ -1627,8 +1628,16 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
*len += 2;
}
else { /* using ' for package separator */
- if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
- Newx(tmpbuf, full_len+2, char);
+ /* use our pre-allocated buffer when possible to save a malloc */
+ char *tmpbuf;
+ if ( *len+2 <= sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else {
+ /* only malloc once if needed */
+ if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpfullbuf, full_len+2, char);
+ tmpbuf = tmpfullbuf;
+ }
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1637,7 +1646,8 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
if (!*gv || *gv == (const GV *)&PL_sv_undef) {
- Safefree(tmpbuf);
+ if ( tmpfullbuf != smallbuf )
+ Safefree(tmpfullbuf);
return FALSE;
}
/* here we know that *gv && *gv != &PL_sv_undef */
@@ -1679,7 +1689,8 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
}
}
- Safefree(tmpbuf);
+ if ( tmpfullbuf != smallbuf )
+ Safefree(tmpfullbuf);
return TRUE;
}
}
--
2.10.1 (Apple Git-78)
|
From @cpansproutOn Thu, 27 Apr 2017 11:32:02 -0700, atoomic wrote:
By instances I mean occurrences in production code. -- Father Chrysostomos |
From @tonycozOn Thu, 27 Apr 2017 11:32:02 -0700, atoomic wrote:
Sorry I lost this ticket. There's a couple of issues with the second patch: 1) there's no tests that use the longer allocated buffer. This includes existing tests. From a gcov run: 14: 1635: if ( *len+2 <= sizeof smallbuf) 2) You have this code in a couple of places: if ( tmpfullbuf != smallbuf ) but this condition is always true (tmpfullbuf can be NULL or allocated, it's never smallbuf). Tony |
From @atoomicThanks Tony for the update, I've addressed your two concerns which were accurate. 1/ add a unit test using long stash names: t/op/stash_parse_gv.t 2/ the 'tmpfullbuf != smallbuf' check is wrong and useless, should simply call Safefree which already perform the check for us when leaving the function You would find attached to this reply the updated patches rebased on a recent blead version. They are also available on my github account for readability: Thanks On Wed, 30 Aug 2017 21:10:09 -0700, tonyc wrote:
|
From @atoomic0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patchFrom b8826c6960dea3a64fbcaed1d10005c76cbc48e9 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 09:55:05 -0600
Subject: [PATCH 1/3] Reduce malloc&free for S_parse_gv_stash_name
S_parse_gv_stash_name was using multiple malloc
and free when using ' as package separator.
We can malloc & free only once the tmpbuffer as we know the size max.
This is also sligthly improving iterations when using ::
as we do not need to check if we need to free the tmp buffer.
This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check.
---
gv.c | 25 +++++++++++++------------
1 file changed, 13 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index afddfe48a8..4bb534b6f1 100644
--- a/gv.c
+++ b/gv.c
@@ -1595,6 +1595,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
+ char *tmpbuf = NULL;
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
@@ -1627,9 +1628,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
key = *name;
*len += 2;
}
- else {
- char *tmpbuf;
- Newx(tmpbuf, *len+2, char);
+ else { /* using ' for package separator */
+ if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpbuf, full_len+2, char);
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1637,16 +1638,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
}
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
- if (*gv && *gv != (const GV *)&PL_sv_undef) {
- if (SvTYPE(*gv) != SVt_PVGV)
- gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
- else
- GvMULTI_on(*gv);
- }
- if (key != *name)
- Safefree(key);
- if (!*gv || *gv == (const GV *)&PL_sv_undef)
+ if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+ Safefree(tmpbuf);
return FALSE;
+ }
+ /* here we know that *gv && *gv != &PL_sv_undef */
+ if (SvTYPE(*gv) != SVt_PVGV)
+ gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+ else
+ GvMULTI_on(*gv);
if (!(*stash = GvHV(*gv))) {
*stash = GvHV(*gv) = newHV();
@@ -1681,6 +1681,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
}
}
+ Safefree(tmpbuf);
return TRUE;
}
}
--
2.14.1
|
From @atoomic0002-add-a-small-buffer-to-gv_stash_name.patchFrom fe56c2b0f1c3268dccba31dcca1bed627d5fd3ae Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Thu, 27 Apr 2017 11:29:48 -0600
Subject: [PATCH 2/3] add a small buffer to gv_stash_name
---
gv.c | 19 ++++++++++++++-----
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/gv.c b/gv.c
index 4bb534b6f1..cfe4be572c 100644
--- a/gv.c
+++ b/gv.c
@@ -1595,10 +1595,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
STRLEN *len, const char *nambeg, STRLEN full_len,
const U32 is_utf8, const I32 add)
{
- char *tmpbuf = NULL;
+ char *tmpfullbuf = NULL; /* only malloc one big chunk of memory when the smallbuff is not large enough */
const char *name_cursor;
const char *const name_end = nambeg + full_len;
const char *const name_em1 = name_end - 1;
+ char smallbuf[64]; /* small buffer to avoid a malloc when possible */
PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
@@ -1629,8 +1630,16 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
*len += 2;
}
else { /* using ' for package separator */
- if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
- Newx(tmpbuf, full_len+2, char);
+ /* use our pre-allocated buffer when possible to save a malloc */
+ char *tmpbuf;
+ if ( *len+2 <= sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else {
+ /* only malloc once if needed */
+ if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */
+ Newx(tmpfullbuf, full_len+2, char);
+ tmpbuf = tmpfullbuf;
+ }
Copy(*name, tmpbuf, *len, char);
tmpbuf[(*len)++] = ':';
tmpbuf[(*len)++] = ':';
@@ -1639,7 +1648,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
*gv = gvp ? *gvp : NULL;
if (!*gv || *gv == (const GV *)&PL_sv_undef) {
- Safefree(tmpbuf);
+ Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
return FALSE;
}
/* here we know that *gv && *gv != &PL_sv_undef */
@@ -1681,7 +1690,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
}
}
- Safefree(tmpbuf);
+ Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
return TRUE;
}
}
--
2.14.1
|
From @atoomic0003-Add-unit-test-t-op-stash_parse_gv.t.patchFrom 7ddad600bc5a6acf37d637f158fd462b10633e17 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Fri, 1 Sep 2017 13:32:43 -0600
Subject: [PATCH 3/3] Add unit test t/op/stash_parse_gv.t
This test add coverage for long function names
in order to increase test coverage for
S_parse_gv_stash_name function.
---
MANIFEST | 1 +
t/op/stash_parse_gv.t | 31 +++++++++++++++++++++++++++++++
2 files changed, 32 insertions(+)
create mode 100644 t/op/stash_parse_gv.t
diff --git a/MANIFEST b/MANIFEST
index 70b0427153..effc4665ca 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5699,6 +5699,7 @@ t/op/sprintf2.t See if sprintf works
t/op/srand.t See if srand works
t/op/sselect.t See if 4 argument select works
t/op/stash.t See if %:: stashes work
+t/op/stash_parse_gv.t See if parse_gv_stash_name works
t/op/stat.t See if stat works
t/op/state.t See if state variables work
t/op/study.t See if study works
diff --git a/t/op/stash_parse_gv.t b/t/op/stash_parse_gv.t
new file mode 100644
index 0000000000..05694ca8ce
--- /dev/null
+++ b/t/op/stash_parse_gv.t
@@ -0,0 +1,31 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ require "./test.pl";
+ set_up_inc(qw(../lib));
+}
+
+plan( tests => 5 );
+
+my $long = 'x' x 100;
+my $short = 'abcd';
+
+my @tests = (
+ [ $long, 'long package name: one word' ],
+ [ join( '::', $long, $long ), 'long package name: multiple words' ],
+ [ join( q['], $long, $long ), q[long package name: multiple words using "'" separator] ],
+ [ join( '::', $long, $short, $long ), 'long & short package name: multiple words' ],
+ [ join( q['], $long, $short, $long ), q[long & short package name: multiple words using "'" separator] ],
+);
+
+foreach my $t (@tests) {
+ my ( $sub, $name ) = @$t;
+
+ fresh_perl_is(
+ qq[sub $sub { print qq[ok\n]} &{"$sub"} ],
+ q[ok],
+ { switches => ['-w'] },
+ $name
+ );
+}
--
2.14.1
|
From @tonycozOn Fri, 01 Sep 2017 13:15:55 -0700, atoomic wrote:
Thanks, applied as f8ac814, 8c573be and f3d6edb. For anyone watching at home the bench results have improved over my original tests above: Higher is better: for example, using half as many instructions gives 200%, package::simple blead blead+patch COND_m 100.00 280.00 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::quote blead blead+patch COND_m 100.00 288.00 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 package::colon blead blead+patch COND_m 100.00 120.00 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 AVERAGE blead blead+patch COND_m 100.00 195.10 Ir_m1 100.00 100.00 Ir_mm 100.00 100.00 Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release yesterday of Perl 5.28.0, this and 185 other issues have been Perl 5.28.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#129990 (status was 'resolved')
Searchable as RT129990$
The text was updated successfully, but these errors were encountered: