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
More VMS patches from Peter Prymmer.
[perl5.git]
/
pp_hot.c
diff --git
a/pp_hot.c
b/pp_hot.c
index
8dab651
..
6027766
100644
(file)
--- a/
pp_hot.c
+++ b/
pp_hot.c
@@
-22,13
+22,6
@@
#ifdef I_UNISTD
#include <unistd.h>
#endif
#ifdef I_UNISTD
#include <unistd.h>
#endif
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
/* Hot code. */
/* Hot code. */
@@
-173,18
+166,27
@@
PP(pp_concat)
s = SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
s = SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_
MISC
)) {
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_
Y2K
)) {
STRLEN n;
char *s = SvPV(TARG,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
STRLEN n;
char *s = SvPV(TARG,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_
MISC
, "Possible Y2K bug: %s",
+ Perl_warner(aTHX_ WARN_
Y2K
, "Possible Y2K bug: %s",
"about to append an integer to '19'");
}
}
#endif
"about to append an integer to '19'");
}
}
#endif
+ if (DO_UTF8(right))
+ sv_utf8_upgrade(TARG);
sv_catpvn(TARG,s,len);
sv_catpvn(TARG,s,len);
+ if (!IN_BYTE) {
+ if (SvUTF8(right))
+ SvUTF8_on(TARG);
+ }
+ else if (!SvUTF8(right)) {
+ SvUTF8_off(TARG);
+ }
}
else
sv_setpvn(TARG,s,len); /* suppress warning */
}
else
sv_setpvn(TARG,s,len); /* suppress warning */
@@
-715,14
+717,14
@@
PP(pp_aassign)
if (relem == lastrelem) {
if (*relem) {
HE *didstore;
if (relem == lastrelem) {
if (*relem) {
HE *didstore;
- if (ckWARN(WARN_
UNSAFE
)) {
+ if (ckWARN(WARN_
MISC
)) {
if (relem == firstrelem &&
SvROK(*relem) &&
( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
if (relem == firstrelem &&
SvROK(*relem) &&
( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- Perl_warner(aTHX_ WARN_
UNSAFE
, "Reference found where even-sized list expected");
+ Perl_warner(aTHX_ WARN_
MISC
, "Reference found where even-sized list expected");
else
else
- Perl_warner(aTHX_ WARN_
UNSAFE
, "Odd number of elements in hash assignment");
+ Perl_warner(aTHX_ WARN_
MISC
, "Odd number of elements in hash assignment");
}
tmpstr = NEWSV(29,0);
didstore = hv_store_ent(hash,*relem,tmpstr,0);
}
tmpstr = NEWSV(29,0);
didstore = hv_store_ent(hash,*relem,tmpstr,0);
@@
-1254,9
+1256,9
@@
Perl_do_readline(pTHX)
}
}
if (!fp) {
}
}
if (!fp) {
- if (ckWARN
(
WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+ if (ckWARN
2(WARN_GLOB,
WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_
CLOSED
,
+ Perl_warner(aTHX_ WARN_
GLOB
,
"glob failed (can't start child: %s)",
Strerror(errno));
else
"glob failed (can't start child: %s)",
Strerror(errno));
else
@@
-1305,8
+1307,8
@@
Perl_do_readline(pTHX)
(void)do_close(PL_last_in_gv, FALSE);
}
else if (type == OP_GLOB) {
(void)do_close(PL_last_in_gv, FALSE);
}
else if (type == OP_GLOB) {
- if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_
CLOSED
)) {
- Perl_warner(aTHX_ WARN_
CLOSED
,
+ if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_
GLOB
)) {
+ Perl_warner(aTHX_ WARN_
GLOB
,
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");