Skip to content

don't call vivifier macros Perl_error_log/Perl_debug_log in a loop #23356

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: blead
Choose a base branch
from
Open

don't call vivifier macros Perl_error_log/Perl_debug_log in a loop #23356

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 43 additions & 29 deletions dump.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -877,33 +877,36 @@ void
Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
{
CV *cv;
PerlIO * debug_log;
bool is_gv;

PERL_ARGS_ASSERT_DUMP_SUB_PERL;

cv = isGV_with_GP(gv) ? GvCV(gv) : CV_FROM_REF((SV*)gv);
cv = (is_gv = cBOOL(isGV_with_GP(gv))) ? GvCV(gv) : CV_FROM_REF((SV*)gv);
if (justperl && (CvISXSUB(cv) || !CvROOT(cv)))
return;

if (isGV_with_GP(gv)) {
debug_log = Perl_debug_log;
if (is_gv) {
SV * const namesv = newSVpvs_flags("", SVs_TEMP);
SV *escsv = newSVpvs_flags("", SVs_TEMP);
const char *namepv;
STRLEN namelen;
gv_fullname3(namesv, gv, NULL);
namepv = SvPV_const(namesv, namelen);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
Perl_dump_indent(aTHX_ 0, debug_log, "\nSUB %s = ",
generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv)));
} else {
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = ");
Perl_dump_indent(aTHX_ 0, debug_log, "\nSUB = ");
}
if (CvISXSUB(cv))
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n",
Perl_dump_indent(aTHX_ 0, debug_log, "(xsub 0x%" UVxf " %d)\n",
PTR2UV(CvXSUB(cv)),
(int)CvXSUBANY(cv).any_i32);
else if (CvROOT(cv))
op_dump(CvROOT(cv));
else
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
Perl_dump_indent(aTHX_ 0, debug_log, "<undef>\n");
}

/*
Expand Down Expand Up @@ -1646,26 +1649,27 @@ Perl_gv_dump(pTHX_ GV *gv)
{
STRLEN len;
const char* name;
PerlIO * debug_log = Perl_debug_log;
SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);

if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
PerlIO_printf(debug_log, "{}\n");
return;
}
sv = sv_newmortal();
PerlIO_printf(Perl_debug_log, "{\n");
PerlIO_printf(debug_log, "{\n");
gv_fullname3(sv, gv, NULL);
name = SvPV_const(sv, len);
Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
Perl_dump_indent(aTHX_ 1, debug_log, "GV_NAME = %s",
generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
if (gv != GvEGV(gv)) {
gv_efullname3(sv, GvEGV(gv), NULL);
name = SvPV_const(sv, len);
Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
Perl_dump_indent(aTHX_ 1, debug_log, "-> %s",
generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
}
(void)PerlIO_putc(Perl_debug_log, '\n');
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
(void)PerlIO_putc(debug_log, '\n');
Perl_dump_indent(aTHX_ 0, debug_log, "}\n");
}


Expand Down Expand Up @@ -3022,24 +3026,25 @@ S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
CV * const cv = deb_curcv(cxstack_ix);
PADNAMELIST *comppad = NULL;
int i;
PerlIO * debug_log = Perl_debug_log;

if (cv) {
PADLIST * const padlist = CvPADLIST(cv);
comppad = PadlistNAMES(padlist);
}
if (paren)
PerlIO_printf(Perl_debug_log, "(");
PerlIO_printf(debug_log, "(");
for (i = 0; i < n; i++) {
if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
PerlIO_printf(Perl_debug_log, "%" PNf, PNfARG(sv));
PerlIO_printf(debug_log, "%" PNf, PNfARG(sv));
else
PerlIO_printf(Perl_debug_log, "[%" UVuf "]",
PerlIO_printf(debug_log, "[%" UVuf "]",
(UV)(off+i));
if (i < n - 1)
PerlIO_printf(Perl_debug_log, ",");
PerlIO_printf(debug_log, ",");
}
if (paren)
PerlIO_printf(Perl_debug_log, ")");
PerlIO_printf(debug_log, ")");
}


Expand Down Expand Up @@ -3297,12 +3302,15 @@ Implements B<-Dt> perl command line option on OP C<o>.
I32
Perl_debop(pTHX_ const OP *o)
{
PerlIO * debug_log;

PERL_ARGS_ASSERT_DEBOP;

if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;

Perl_deb(aTHX_ "%s", OP_NAME(o));
debug_log = Perl_debug_log;
switch (o->op_type) {
case OP_CONST:
case OP_HINTSEVAL:
Expand All @@ -3313,11 +3321,11 @@ Perl_debop(pTHX_ const OP *o)
#ifdef USE_ITHREADS
if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
#endif
PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
PerlIO_printf(debug_log, "(%s)", SvPEEK(cSVOPo_sv));
break;
case OP_GVSV:
case OP_GV:
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
PerlIO_printf(debug_log, "(%" SVf ")",
SVfARG(S_gv_display(aTHX_ cGVOPo_gv)));
break;

Expand All @@ -3334,19 +3342,19 @@ Perl_debop(pTHX_ const OP *o)
break;

case OP_MULTIDEREF:
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
PerlIO_printf(debug_log, "(%" SVf ")",
SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
break;

case OP_MULTICONCAT:
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
PerlIO_printf(debug_log, "(%" SVf ")",
SVfARG(multiconcat_stringify(o)));
break;

default:
break;
}
PerlIO_printf(Perl_debug_log, "\n");
PerlIO_printf(debug_log, "\n");
return 0;
}

Expand Down Expand Up @@ -3548,9 +3556,12 @@ S_debprof(pTHX_ const OP *o)

if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
return;
if (!PL_profiledata)
Newxz(PL_profiledata, MAXO, U32);
++PL_profiledata[o->op_type];
U32 * profiledata = PL_profiledata;
if (!profiledata) {
Newxz(profiledata, MAXO, U32);
PL_profiledata = profiledata;
}
++profiledata[o->op_type];
}

/*
Expand All @@ -3568,11 +3579,14 @@ Perl_debprofdump(pTHX)
unsigned i;
if (!PL_profiledata)
return;
PerlIO * debug_log = Perl_debug_log;
U32 * profiledata = PL_profiledata;
const char * const * const x_PL_op_names = PL_op_name;
for (i = 0; i < MAXO; i++) {
if (PL_profiledata[i])
PerlIO_printf(Perl_debug_log,
"%5lu %s\n", (unsigned long)PL_profiledata[i],
PL_op_name[i]);
if (profiledata[i])
PerlIO_printf(debug_log,
"%5lu %s\n", (unsigned long)profiledata[i],
x_PL_op_names[i]);
}
}

Expand Down
1 change: 1 addition & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4616,6 +4616,7 @@ S |const char *|native_querylocale_i \
S |void |new_LC_ALL |NN const char *lc_all \
|bool force
S |void |output_check_environment_warning \
|NN PerlIO * const error_log \
|NULLOK const char * const language \
|NULLOK const char * const lc_all \
|NULLOK const char * const lang
Expand Down
2 changes: 1 addition & 1 deletion embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1377,7 +1377,7 @@
# define mortalized_pv_copy(a) S_mortalized_pv_copy(aTHX_ a)
# define native_querylocale_i(a) S_native_querylocale_i(aTHX_ a)
# define new_LC_ALL(a,b) S_new_LC_ALL(aTHX_ a,b)
# define output_check_environment_warning(a,b,c) S_output_check_environment_warning(aTHX_ a,b,c)
# define output_check_environment_warning(a,b,c,d) S_output_check_environment_warning(aTHX_ a,b,c,d)
# define parse_LC_ALL_string(a,b,c,d,e,f) S_parse_LC_ALL_string(aTHX_ a,b,c,d,e,f)
# define save_to_buffer(a,b,c) S_save_to_buffer(aTHX_ a,b,c)
# define set_save_buffer_min_size(a,b,c) S_set_save_buffer_min_size(aTHX_ a,b,c)
Expand Down
27 changes: 15 additions & 12 deletions locale.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8762,43 +8762,44 @@ S_give_perl_locale_control(pTHX_
}

STATIC void
S_output_check_environment_warning(pTHX_ const char * const language,
S_output_check_environment_warning(pTHX_ PerlIO * const error_log,
const char * const language,
const char * const lc_all,
const char * const lang)
{
PerlIO_printf(Perl_error_log,
PerlIO_printf(error_log,
"perl: warning: Please check that your locale settings:\n");

# ifdef __GLIBC__

PerlIO_printf(Perl_error_log, "\tLANGUAGE = %c%s%c,\n",
PerlIO_printf(error_log, "\tLANGUAGE = %c%s%c,\n",
language ? '"' : '(',
language ? language : "unset",
language ? '"' : ')');
# else
PERL_UNUSED_ARG(language);
# endif

PerlIO_printf(Perl_error_log, "\tLC_ALL = %c%s%c,\n",
PerlIO_printf(error_log, "\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
lc_all ? lc_all : "unset",
lc_all ? '"' : ')');

for_all_individual_category_indexes(i) {
const char * value = PerlEnv_getenv(category_names[i]);
PerlIO_printf(Perl_error_log,
PerlIO_printf(error_log,
"\t%s = %c%s%c,\n",
category_names[i],
value ? '"' : '(',
value ? value : "unset",
value ? '"' : ')');
}

PerlIO_printf(Perl_error_log, "\tLANG = %c%s%c\n",
PerlIO_printf(error_log, "\tLANG = %c%s%c\n",
lang ? '"' : '(',
lang ? lang : "unset",
lang ? '"' : ')');
PerlIO_printf(Perl_error_log,
PerlIO_printf(error_log,
" are supported and installed on your system.\n");
}

Expand Down Expand Up @@ -9211,9 +9212,10 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
}

if (trial == 0 && locwarn) {
PerlIO_printf(Perl_error_log,
PerlIO * error_log = Perl_error_log;
PerlIO_printf(error_log,
"perl: warning: Setting locale failed.\n");
output_check_environment_warning(language, lc_all, lang);
output_check_environment_warning(error_log, language, lc_all, lang);
}

# else /* Below is ! LC_ALL */
Expand Down Expand Up @@ -9247,16 +9249,17 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
/* Here, this trial failed */

if (dowarn) {
PerlIO_printf(Perl_error_log,
PerlIO * error_log = Perl_error_log;
PerlIO_printf(error_log,
"perl: warning: Setting locale failed for the categories:\n");

for_all_individual_category_indexes(j) {
if (! curlocales[j]) {
PerlIO_printf(Perl_error_log, "\t%s\n", category_names[j]);
PerlIO_printf(error_log, "\t%s\n", category_names[j]);
}
}

output_check_environment_warning(language, lc_all, lang);
output_check_environment_warning(error_log, language, lc_all, lang);
} /* end of warning on first failure */

# endif /* LC_ALL */
Expand Down
5 changes: 3 additions & 2 deletions proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

11 changes: 6 additions & 5 deletions util.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4871,23 +4871,24 @@ Perl_debug_hash_seed(pTHX_ bool via_debug_h)
bool via_env = cBOOL(s && strNE(s, "0") && strNE(s,""));

if ( via_env != via_debug_h ) {
PerlIO * debug_log = Perl_debug_log;
const unsigned char *seed= PERL_HASH_SEED;
const unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
PerlIO_printf(debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
while (seed < seed_end) {
PerlIO_printf(Perl_debug_log, "%02x", *seed++);
PerlIO_printf(debug_log, "%02x", *seed++);
}
#ifdef PERL_HASH_RANDOMIZE_KEYS
PerlIO_printf(Perl_debug_log, " PERTURB_KEYS = %d (%s)",
PerlIO_printf(debug_log, " PERTURB_KEYS = %d (%s)",
PL_HASH_RAND_BITS_ENABLED,
PL_HASH_RAND_BITS_ENABLED == 0 ? "NO" :
PL_HASH_RAND_BITS_ENABLED == 1 ? "RANDOM"
: "DETERMINISTIC");
if (DEBUG_h_TEST)
PerlIO_printf(Perl_debug_log,
PerlIO_printf(debug_log,
" RAND_BITS=0x%" UVxf, PL_hash_rand_bits);
#endif
PerlIO_printf(Perl_debug_log, "\n");
PerlIO_printf(debug_log, "\n");
}
}
#endif /* #if (defined(USE_HASH_SEED) ... */
Expand Down
Loading