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
Make global cleanup fractionally faster by giving S_visit()
[perl5.git]
/
mg.c
diff --git
a/mg.c
b/mg.c
index
4ef7910
..
d86e22d
100644
(file)
--- a/
mg.c
+++ b/
mg.c
@@
-1,7
+1,7
@@
/* mg.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
/* mg.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003,
2004,
by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@
-397,10
+397,7
@@
Perl_mg_free(pTHX_ SV *sv)
return 0;
}
return 0;
}
-
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#include <signal.h>
-#endif
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
@@
-569,9
+566,6
@@
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
case '\004': /* ^D */
sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
case '\004': /* ^D */
sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
-#if defined(YYDEBUG) && defined(DEBUGGING)
- PL_yydebug = DEBUG_p_TEST;
-#endif
break;
case '\005': /* ^E */
if (*(mg->mg_ptr+1) == '\0') {
break;
case '\005': /* ^E */
if (*(mg->mg_ptr+1) == '\0') {
@@
-651,8
+645,10
@@
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
sv_setsv(sv, &PL_sv_undef);
break;
case '\017': /* ^O & ^OPEN */
sv_setsv(sv, &PL_sv_undef);
break;
case '\017': /* ^O & ^OPEN */
- if (*(mg->mg_ptr+1) == '\0')
+ if (*(mg->mg_ptr+1) == '\0')
{
sv_setpv(sv, PL_osname);
sv_setpv(sv, PL_osname);
+ SvTAINTED_off(sv);
+ }
else if (strEQ(mg->mg_ptr, "\017PEN")) {
if (!PL_compiling.cop_io)
sv_setsv(sv, &PL_sv_undef);
else if (strEQ(mg->mg_ptr, "\017PEN")) {
if (!PL_compiling.cop_io)
sv_setsv(sv, &PL_sv_undef);
@@
-1784,16
+1780,21
@@
Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
sv_utf8_upgrade(lsv);
sv_pos_u2b(lsv, &lvoff, &lvlen);
sv_insert(lsv, lvoff, lvlen, tmps, len);
sv_utf8_upgrade(lsv);
sv_pos_u2b(lsv, &lvoff, &lvlen);
sv_insert(lsv, lvoff, lvlen, tmps, len);
+ LvTARGLEN(sv) = sv_len_utf8(sv);
SvUTF8_on(lsv);
}
else if (lsv && SvUTF8(lsv)) {
sv_pos_u2b(lsv, &lvoff, &lvlen);
SvUTF8_on(lsv);
}
else if (lsv && SvUTF8(lsv)) {
sv_pos_u2b(lsv, &lvoff, &lvlen);
+ LvTARGLEN(sv) = len;
tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
sv_insert(lsv, lvoff, lvlen, tmps, len);
Safefree(tmps);
}
tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
sv_insert(lsv, lvoff, lvlen, tmps, len);
Safefree(tmps);
}
- else
- sv_insert(lsv, lvoff, lvlen, tmps, len);
+ else {
+ sv_insert(lsv, lvoff, lvlen, tmps, len);
+ LvTARGLEN(sv) = len;
+ }
+
return 0;
}
return 0;
}
@@
-1930,14
+1931,14
@@
Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
SV **svp = AvARRAY(av);
I32 i = AvFILLp(av);
while (i >= 0) {
SV **svp = AvARRAY(av);
I32 i = AvFILLp(av);
while (i >= 0) {
- if (svp[i]
&& svp[i] != &PL_sv_undef
) {
+ if (svp[i]) {
if (!SvWEAKREF(svp[i]))
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
SvRV(svp[i]) = 0;
(void)SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
if (!SvWEAKREF(svp[i]))
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
SvRV(svp[i]) = 0;
(void)SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
- svp[i] =
&PL_sv_undef
;
+ svp[i] =
Nullsv
;
}
i--;
}
}
i--;
}
@@
-2092,12
+2093,14
@@
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
break;
case '\017': /* ^O */
if (*(mg->mg_ptr+1) == '\0') {
break;
case '\017': /* ^O */
if (*(mg->mg_ptr+1) == '\0') {
- if (PL_osname)
+ if (PL_osname)
{
Safefree(PL_osname);
Safefree(PL_osname);
- if (SvOK(sv))
- PL_osname = savepv(SvPV(sv,len));
- else
PL_osname = Nullch;
PL_osname = Nullch;
+ }
+ if (SvOK(sv)) {
+ TAINT_PROPER("assigning to $^O");
+ PL_osname = savepv(SvPV(sv,len));
+ }
}
else if (strEQ(mg->mg_ptr, "\017PEN")) {
if (!PL_compiling.cop_io)
}
else if (strEQ(mg->mg_ptr, "\017PEN")) {
if (!PL_compiling.cop_io)