Use preprocessor check for some DEBUG_X_TEST calls in sv.c and toke.c #16170
Comments
From @atoomicThis is a bug report for perl from atoomic@cpan.org, Most of the DEBUG_?_TEST calls are already protected We should avoid these extra 'if' statements if perl Tested by running testsuite with/without -DDEBUGGING option Flags: Site configuration information for perl 5.27.5: Configured by root at Mon Sep 25 12:23:53 CDT 2017. Summary of my perl5 (revision 5 version 27 subversion 5) configuration: @INC for perl 5.27.5: Environment for perl 5.27.5: PATH=/usr/local/cpanel/3rdparty/perl/526/bin:/usr/local/cpanel/3rdparty/perl/524/bin:/usr/local/cpanel/3rdparty/perl/522/bin:/usr/local/cpanel/3rdparty/perl/514/bin:/usr/local/cpanel/3rdparty/bin:/root/bin/:/opt/local/bin:/opt/local/sbin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/opt/cpanel/composer/bin:/root/.dotfiles/bin:/root/perl5/bin:/root/.rvm/bin:/root/bin |
From @atoomic0001-Use-preprocessor-check-for-some-DEBUG_X_TEST.patchFrom e0ede300d5b7e50cc49cb1da9545c11bb14b6bec Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 25 Sep 2017 12:18:28 -0500
Subject: [PATCH] Use preprocessor check for some DEBUG_X_TEST
Most of the DEBUG_?_TEST calls are already protected
by one '#idef DEBUGGING' check, but noticed a few of them
which were not protected in sv.c and toke.c
We should avoid these extra 'if' statements if perl
is not compiled with debug option: -DDEBUGGING.
---
sv.c | 22 +++++++++++++++-------
toke.c | 10 ++++++++++
2 files changed, 25 insertions(+), 7 deletions(-)
diff --git a/sv.c b/sv.c
index 6dcd99ae59..9d8b00bf4b 100644
--- a/sv.c
+++ b/sv.c
@@ -4694,11 +4694,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
) {
/* Either it's a shared hash key, or it's suitable for
copy-on-write. */
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Copy on write: sstr --> dstr\n");
sv_dump(sstr);
sv_dump(dstr);
}
+#endif
#ifdef PERL_ANY_COW
if (!(sflags & SVf_IsCOW)) {
SvIsCOW_on(sstr);
@@ -4872,7 +4874,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
#endif
PERL_ARGS_ASSERT_SV_SETSV_COW;
-
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Fast copy on write: %p -> %p\n",
(void*)sstr, (void*)dstr);
@@ -4880,7 +4882,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
if (dstr)
sv_dump(dstr);
}
-
+#endif
if (dstr) {
if (SvTHINKFIRST(dstr))
sv_force_normal_flags(dstr, SV_COW_DROP_PV);
@@ -4927,9 +4929,10 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
SvUTF8_on(dstr);
SvLEN_set(dstr, len);
SvCUR_set(dstr, cur);
- if (DEBUG_C_TEST) {
- sv_dump(dstr);
- }
+#ifdef DEBUGGING
+ if (DEBUG_C_TEST)
+ sv_dump(dstr);
+#endif
return dstr;
}
#endif
@@ -5215,12 +5218,14 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
const STRLEN len = SvLEN(sv);
const STRLEN cur = SvCUR(sv);
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
"Copy on write: Force normal %ld\n",
(long) flags);
sv_dump(sv);
}
+#endif
SvIsCOW_off(sv);
# ifdef PERL_COPY_ON_WRITE
if (len) {
@@ -5260,9 +5265,10 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
} else {
unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
}
- if (DEBUG_C_TEST) {
+#ifdef DEBUGGING
+ if (DEBUG_C_TEST)
sv_dump(sv);
- }
+#endif
}
#else
const char * const pvx = SvPVX_const(sv);
@@ -6805,10 +6811,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
&& !(IoFLAGS(sv) & IOf_FAKE_DIRP)))
{
if (SvIsCOW(sv)) {
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
sv_dump(sv);
}
+#endif
if (SvLEN(sv)) {
if (CowREFCNT(sv)) {
sv_buf_to_rw(sv);
diff --git a/toke.c b/toke.c
index a91a4fcfbe..6ae26801a6 100644
--- a/toke.c
+++ b/toke.c
@@ -11698,7 +11698,9 @@ S_swallow_bom(pTHX_ U8 *s)
/* diag_listed_as: Unsupported script encoding %s */
Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char*)s) {
s = add_utf16_textfilter(s, TRUE);
@@ -11712,7 +11714,9 @@ S_swallow_bom(pTHX_ U8 *s)
case 0xFE:
if (s[1] == 0xFF) { /* UTF-16 big-endian? */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char *)s) {
s = add_utf16_textfilter(s, FALSE);
@@ -11726,7 +11730,9 @@ S_swallow_bom(pTHX_ U8 *s)
case BOM_UTF8_FIRST_BYTE: {
const STRLEN len = sizeof(BOM_UTF8_TAIL) - 1; /* Exclude trailing NUL */
if (slen > len && memEQ(s+1, BOM_UTF8_TAIL, len)) {
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-8 script encoding (BOM)\n");
+#endif
s += len + 1; /* UTF-8 */
}
break;
@@ -11745,7 +11751,9 @@ S_swallow_bom(pTHX_ U8 *s)
* 00 xx 00 xx
* are a good indicator of UTF-16BE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, FALSE);
#else
/* diag_listed_as: Unsupported script encoding %s */
@@ -11761,7 +11769,9 @@ S_swallow_bom(pTHX_ U8 *s)
* xx 00 xx 00
* are a good indicator of UTF-16LE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, TRUE);
#else
/* diag_listed_as: Unsupported script encoding %s */
--
2.14.1
|
From @atoomicadd inline patch On Mon, 25 Sep 2017 11:16:33 -0700, atoomic@cpan.org wrote:
|
From @atoomic0001-Use-preprocessor-check-for-some-DEBUG_X_TEST.patchFrom e0ede300d5b7e50cc49cb1da9545c11bb14b6bec Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 25 Sep 2017 12:18:28 -0500
Subject: [PATCH] Use preprocessor check for some DEBUG_X_TEST
Most of the DEBUG_?_TEST calls are already protected
by one '#idef DEBUGGING' check, but noticed a few of them
which were not protected in sv.c and toke.c
We should avoid these extra 'if' statements if perl
is not compiled with debug option: -DDEBUGGING.
---
sv.c | 22 +++++++++++++++-------
toke.c | 10 ++++++++++
2 files changed, 25 insertions(+), 7 deletions(-)
diff --git a/sv.c b/sv.c
index 6dcd99ae59..9d8b00bf4b 100644
--- a/sv.c
+++ b/sv.c
@@ -4694,11 +4694,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
) {
/* Either it's a shared hash key, or it's suitable for
copy-on-write. */
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Copy on write: sstr --> dstr\n");
sv_dump(sstr);
sv_dump(dstr);
}
+#endif
#ifdef PERL_ANY_COW
if (!(sflags & SVf_IsCOW)) {
SvIsCOW_on(sstr);
@@ -4872,7 +4874,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
#endif
PERL_ARGS_ASSERT_SV_SETSV_COW;
-
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Fast copy on write: %p -> %p\n",
(void*)sstr, (void*)dstr);
@@ -4880,7 +4882,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
if (dstr)
sv_dump(dstr);
}
-
+#endif
if (dstr) {
if (SvTHINKFIRST(dstr))
sv_force_normal_flags(dstr, SV_COW_DROP_PV);
@@ -4927,9 +4929,10 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
SvUTF8_on(dstr);
SvLEN_set(dstr, len);
SvCUR_set(dstr, cur);
- if (DEBUG_C_TEST) {
- sv_dump(dstr);
- }
+#ifdef DEBUGGING
+ if (DEBUG_C_TEST)
+ sv_dump(dstr);
+#endif
return dstr;
}
#endif
@@ -5215,12 +5218,14 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
const STRLEN len = SvLEN(sv);
const STRLEN cur = SvCUR(sv);
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
"Copy on write: Force normal %ld\n",
(long) flags);
sv_dump(sv);
}
+#endif
SvIsCOW_off(sv);
# ifdef PERL_COPY_ON_WRITE
if (len) {
@@ -5260,9 +5265,10 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
} else {
unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
}
- if (DEBUG_C_TEST) {
+#ifdef DEBUGGING
+ if (DEBUG_C_TEST)
sv_dump(sv);
- }
+#endif
}
#else
const char * const pvx = SvPVX_const(sv);
@@ -6805,10 +6811,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
&& !(IoFLAGS(sv) & IOf_FAKE_DIRP)))
{
if (SvIsCOW(sv)) {
+#ifdef DEBUGGING
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
sv_dump(sv);
}
+#endif
if (SvLEN(sv)) {
if (CowREFCNT(sv)) {
sv_buf_to_rw(sv);
diff --git a/toke.c b/toke.c
index a91a4fcfbe..6ae26801a6 100644
--- a/toke.c
+++ b/toke.c
@@ -11698,7 +11698,9 @@ S_swallow_bom(pTHX_ U8 *s)
/* diag_listed_as: Unsupported script encoding %s */
Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char*)s) {
s = add_utf16_textfilter(s, TRUE);
@@ -11712,7 +11714,9 @@ S_swallow_bom(pTHX_ U8 *s)
case 0xFE:
if (s[1] == 0xFF) { /* UTF-16 big-endian? */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char *)s) {
s = add_utf16_textfilter(s, FALSE);
@@ -11726,7 +11730,9 @@ S_swallow_bom(pTHX_ U8 *s)
case BOM_UTF8_FIRST_BYTE: {
const STRLEN len = sizeof(BOM_UTF8_TAIL) - 1; /* Exclude trailing NUL */
if (slen > len && memEQ(s+1, BOM_UTF8_TAIL, len)) {
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-8 script encoding (BOM)\n");
+#endif
s += len + 1; /* UTF-8 */
}
break;
@@ -11745,7 +11751,9 @@ S_swallow_bom(pTHX_ U8 *s)
* 00 xx 00 xx
* are a good indicator of UTF-16BE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, FALSE);
#else
/* diag_listed_as: Unsupported script encoding %s */
@@ -11761,7 +11769,9 @@ S_swallow_bom(pTHX_ U8 *s)
* xx 00 xx 00
* are a good indicator of UTF-16LE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, TRUE);
#else
/* diag_listed_as: Unsupported script encoding %s */
--
2.14.1
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon, 25 Sep 2017 11:16:33 -0700, atoomic@cpan.org wrote:
I don't think these changes are necessary. In non-DEBUGGING builds the DEBUG_?_TEST macros are replaced with (0) so the compiler should be optimizing them away. Are you seeing warnings or something that requires this change? Thanks, |
From @atoomicHi Tony, I agree with you this is [probably] not necessary but would mark it as 'good to have'. I would also assume that during compilation optimizations can discard 'if (0)' blocks. But in my understanding, this might depend on your compiler and options you used. Enforcing the pre-processor check guarantee that it always behave the same, and is consistent with the existing code. If you check the codebase, most of other places consuming these DEBUG macros (to do not say all) are already protected by a '#ifdef DEBUGGING' check. I saw no warnings and just noticed it while reviewing a case. The other argument for it, I have for it is when compiling a non-DEBUG perl but with symbols: ./Configure -Dusedevel -Doptimize=-g3 -des I do not want to view non-existing blocks during my gdb sessions. thanks On Tue, 26 Sep 2017 18:44:01 -0700, tonyc wrote:
|
From @tonycozOn Wed, 27 Sep 2017 09:34:18 -0700, atoomic wrote:
You've convinced me, thanks, applied as f0e51ad. 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' |
From @atoomicThank you! Le sam. 23 juin 2018 à 09:31, Karl Williamson via RT <
|
Migrated from rt.perl.org#132159 (status was 'resolved')
Searchable as RT132159$
The text was updated successfully, but these errors were encountered: