This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
The change to the internal representation introduced a bug whereby
[perl5.git]
/
perl.c
diff --git
a/perl.c
b/perl.c
index
4af4e06
..
03187a3
100644
(file)
--- a/
perl.c
+++ b/
perl.c
@@
-237,11
+237,15
@@
perl_construct(pTHXx)
SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
sv_setpv(&PL_sv_no,PL_No);
SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
sv_setpv(&PL_sv_no,PL_No);
+ /* value lookup in void context - happens to have the side effect
+ of caching the numeric forms. */
+ SvIV(&PL_sv_no);
SvNV(&PL_sv_no);
SvREADONLY_on(&PL_sv_no);
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
sv_setpv(&PL_sv_yes,PL_Yes);
SvNV(&PL_sv_no);
SvREADONLY_on(&PL_sv_no);
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
sv_setpv(&PL_sv_yes,PL_Yes);
+ SvIV(&PL_sv_yes);
SvNV(&PL_sv_yes);
SvREADONLY_on(&PL_sv_yes);
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvNV(&PL_sv_yes);
SvREADONLY_on(&PL_sv_yes);
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
@@
-467,7
+471,7
@@
perl_destruct(pTHXx)
*/
#ifndef PERL_MICRO
#if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
*/
#ifndef PERL_MICRO
#if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
- if (environ != PL_origenviron
+ if (environ != PL_origenviron
&& !PL_use_safe_putenv
#ifdef USE_ITHREADS
/* only main thread can free environ[0] contents */
&& PL_curinterp == aTHX
#ifdef USE_ITHREADS
/* only main thread can free environ[0] contents */
&& PL_curinterp == aTHX
@@
-487,6
+491,9
@@
perl_destruct(pTHXx)
#endif
#endif /* !PERL_MICRO */
#endif
#endif /* !PERL_MICRO */
+ /* reset so print() ends up where we expect */
+ setdefout(Nullgv);
+
#ifdef USE_ITHREADS
/* the syntax tree is shared between clones
* so op_free(PL_main_root) only ReREFCNT_dec's
#ifdef USE_ITHREADS
/* the syntax tree is shared between clones
* so op_free(PL_main_root) only ReREFCNT_dec's
@@
-628,9
+635,6
@@
perl_destruct(pTHXx)
PL_dbargs = Nullav;
PL_debstash = Nullhv;
PL_dbargs = Nullav;
PL_debstash = Nullhv;
- /* reset so print() ends up where we expect */
- setdefout(Nullgv);
-
SvREFCNT_dec(PL_argvout_stack);
PL_argvout_stack = Nullav;
SvREFCNT_dec(PL_argvout_stack);
PL_argvout_stack = Nullav;
@@
-837,9
+841,10
@@
perl_destruct(pTHXx)
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK) {
- PerlIO_printf(Perl_debug_log, "leaked: 0x%p"
- pTHX__FORMAT "\n",
- sv pTHX__VALUE);
+ PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
+ " flags=0x08%"UVxf
+ " refcnt=%"UVuf pTHX__FORMAT "\n",
+ sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE);
}
}
}
}
}
}
@@
-911,7
+916,7
@@
perl_destruct(pTHXx)
}
}
/* we know that type >= SVt_PV */
}
}
/* we know that type >= SVt_PV */
-
(void)
SvOOK_off(PL_mess_sv);
+ SvOOK_off(PL_mess_sv);
Safefree(SvPVX(PL_mess_sv));
Safefree(SvANY(PL_mess_sv));
Safefree(PL_mess_sv);
Safefree(SvPVX(PL_mess_sv));
Safefree(SvANY(PL_mess_sv));
Safefree(PL_mess_sv);
@@
-2200,6
+2205,10
@@
Perl_eval_sv(pTHX_ SV *sv, I32 flags)
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
(OP*)&myop, TRUE);
#else
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
(OP*)&myop, TRUE);
#else
+ /* fail now; otherwise we could fail after the JMPENV_PUSH but
+ * before a PUSHEVAL, which corrupts the stack after a croak */
+ TAINT_PROPER("eval_sv()");
+
JMPENV_PUSH(ret);
#endif
switch (ret) {
JMPENV_PUSH(ret);
#endif
switch (ret) {
@@
-2369,12
+2378,12
@@
NULL
#ifdef DEBUGGING
int
#ifdef DEBUGGING
int
-Perl_get_debug_opts(pTHX_ char **s)
+Perl_get_debug_opts(pTHX_ char **s
, bool givehelp
)
{
static char *usage_msgd[] = {
" Debugging flag values: (see also -d)",
" p Tokenizing and parsing (with v, displays parse stack)",
{
static char *usage_msgd[] = {
" Debugging flag values: (see also -d)",
" p Tokenizing and parsing (with v, displays parse stack)",
- " s Stack snapshots
. with v, displays all stacks
",
+ " s Stack snapshots
(with v, displays all stacks)
",
" l Context (loop) stack processing",
" t Trace execution",
" o Method and overloading resolution",
" l Context (loop) stack processing",
" t Trace execution",
" o Method and overloading resolution",
@@
-2384,7
+2393,7
@@
Perl_get_debug_opts(pTHX_ char **s)
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
- " u Tainting checks
(Obsolete, previously used for LEAKTEST)
",
+ " u Tainting checks",
" H Hash dump -- usurps values()",
" X Scratchpad allocation",
" D Cleaning up",
" H Hash dump -- usurps values()",
" X Scratchpad allocation",
" D Cleaning up",
@@
-2395,7
+2404,7
@@
Perl_get_debug_opts(pTHX_ char **s)
" v Verbose: use in conjunction with other flags",
" C Copy On Write",
" A Consistency checks on internal structures",
" v Verbose: use in conjunction with other flags",
" C Copy On Write",
" A Consistency checks on internal structures",
- " q quiet - currently only suppresse
d
the 'EXECUTING' message",
+ " q quiet - currently only suppresse
s
the 'EXECUTING' message",
NULL
};
int i = 0;
NULL
};
int i = 0;
@@
-2416,7
+2425,7
@@
Perl_get_debug_opts(pTHX_ char **s)
i = atoi(*s);
for (; isALNUM(**s); (*s)++) ;
}
i = atoi(*s);
for (; isALNUM(**s); (*s)++) ;
}
- else {
+ else
if (givehelp)
{
char **p = usage_msgd;
while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
}
char **p = usage_msgd;
while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
}
@@
-2500,6
+2509,13
@@
Perl_moreswitches(pTHX_ char *s)
case 'd':
forbid_setid("-d");
s++;
case 'd':
forbid_setid("-d");
s++;
+
+ /* -dt indicates to the debugger that threads will be used */
+ if (*s == 't' && !isALNUM(s[1])) {
+ ++s;
+ my_setenv("PERL5DB_THREADED", "1");
+ }
+
/* The following permits -d:Mod to accepts arguments following an =
in the fashion that -MSome::Mod does. */
if (*s == ':' || *s == '=') {
/* The following permits -d:Mod to accepts arguments following an =
in the fashion that -MSome::Mod does. */
if (*s == ':' || *s == '=') {
@@
-2530,7
+2546,7
@@
Perl_moreswitches(pTHX_ char *s)
#ifdef DEBUGGING
forbid_setid("-D");
s++;
#ifdef DEBUGGING
forbid_setid("-D");
s++;
- PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+ PL_debug = get_debug_opts(&s
, 1
) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
@@
-2662,7
+2678,7
@@
Perl_moreswitches(pTHX_ char *s)
av_push(PL_preambleav, sv);
}
else
av_push(PL_preambleav, sv);
}
else
- Perl_croak(aTHX_ "
No space allowed after
-%c", *(s-1));
+ Perl_croak(aTHX_ "
Missing argument to
-%c", *(s-1));
return s;
case 'n':
PL_minus_n = TRUE;
return s;
case 'n':
PL_minus_n = TRUE;
@@
-2799,7
+2815,7
@@
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
this system using `man perl' or `perldoc perl'. If you have access to the\n\
GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
this system using `man perl' or `perldoc perl'. If you have access to the\n\
-Internet, point your browser at http://www.perl.
com
/, the Perl Home Page.\n\n");
+Internet, point your browser at http://www.perl.
org
/, the Perl Home Page.\n\n");
my_exit(0);
case 'w':
if (! (PL_dowarn & G_WARN_ALL_MASK))
my_exit(0);
case 'w':
if (! (PL_dowarn & G_WARN_ALL_MASK))
@@
-4093,9
+4109,10
@@
S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
{
environ[0] = Nullch;
}
{
environ[0] = Nullch;
}
- if (env)
+ if (env) {
+ char** origenv = environ;
for (; *env; env++) {
for (; *env; env++) {
- if (!(s = strchr(*env,'=')))
+ if (!(s = strchr(*env,'='))
|| s == *env
)
continue;
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
continue;
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
@@
-4106,7
+4123,13
@@
S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
(void)hv_store(hv, *env, s - *env, sv, 0);
if (env != environ)
mg_set(sv);
(void)hv_store(hv, *env, s - *env, sv, 0);
if (env != environ)
mg_set(sv);
+ if (origenv != environ) {
+ /* realloc has shifted us */
+ env = (env - origenv) + environ;
+ origenv = environ;
+ }
}
}
+ }
#endif /* USE_ENVIRON_ARRAY */
#endif /* !PERL_MICRO */
}
#endif /* USE_ENVIRON_ARRAY */
#endif /* !PERL_MICRO */
}