# include <shadow.h>
#endif
-#ifdef I_SYS_WAIT
-# include <sys/wait.h>
-#endif
-
#ifdef I_SYS_RESOURCE
# include <sys/resource.h>
#endif
if (IoDIRP(io))
Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening dirhandle %s also as a file",
- GvENAME(gv));
+ "Opening dirhandle %"HEKf" also as a file",
+ HEKfARG(GvENAME_HEK(gv)));
mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
dTARGET;
Mode_t anum;
- if (MAXARG < 1) {
+ if (MAXARG < 1 || (!TOPs && !POPs)) {
anum = PerlLIO_umask(022);
/* setting it to 022 between the two calls to umask avoids
* to have a window where the umask is set to 0 -- meaning
/* Only DIE if trying to restrict permissions on "user" (self).
* Otherwise it's harmless and more useful to just return undef
* since 'group' and 'other' concepts probably don't exist here. */
- if (MAXARG >= 1 && (POPi & 0700))
+ if (MAXARG >= 1 && (TOPs||POPs) && (POPi & 0700))
DIE(aTHX_ "umask not implemented");
XPUSHs(&PL_sv_undef);
#endif
* wrong error message, and worse case, supreme action at a distance.
* (Sorry obfuscation writers. You're not going to be given this one.)
*/
- STRLEN len;
- const char *name = SvPV_nomg_const(*MARK, len);
- stash = gv_stashpvn(name, len, 0);
- if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
+ stash = gv_stashsv(*MARK, 0);
+ if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
}
if (! hv)
XPUSHs(&PL_sv_undef);
else {
- GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+ GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), HEK_UTF8(GvNAME_HEK(egv)) ? -GvNAMELEN(egv) : GvNAMELEN(egv), FALSE);
if (gvp && *gvp == egv) {
gv_efullname4(TARG, PL_defoutgv, NULL, TRUE);
XPUSHTARG;
cv = GvFORM(fgv);
if (!cv) {
- const char *name;
tmpsv = sv_newmortal();
gv_efullname4(tmpsv, fgv, NULL, FALSE);
- name = SvPV_nolen_const(tmpsv);
- if (name && *name)
- DIE(aTHX_ "Undefined format \"%s\" called", name);
+ if (SvPOK(tmpsv) && *SvPV_nolen_const(tmpsv))
+ DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
not_a_format_reference:
DIE(aTHX_ "Not a format reference");
SV *topname;
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
- topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
+ topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP",
+ HEKfARG(GvNAME_HEK(gv))));
topgv = gv_fetchsv(topname, 0, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
!gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM))
cv = GvFORM(fgv);
if (!cv) {
SV * const sv = sv_newmortal();
- const char *name;
gv_efullname4(sv, fgv, NULL, FALSE);
- name = SvPV_nolen_const(sv);
- if (name && *name)
- DIE(aTHX_ "Undefined top format \"%s\" called", name);
+ if (SvPOK(sv) && *SvPV_nolen_const(sv))
+ DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
else
DIE(aTHX_ "Undefined top format called");
}
PP(pp_sysread)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- int offset;
+ SSize_t offset;
IO *io;
char *buffer;
+ STRLEN orig_size;
SSize_t length;
SSize_t count;
- Sock_size_t bufsize;
SV *bufsv;
STRLEN blen;
int fp_utf8;
#ifdef HAS_SOCKET
if (PL_op->op_type == OP_RECV) {
+ Sock_size_t bufsize;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
bufsize = sizeof (struct sockaddr_in);
blen = sv_len_utf8(bufsv);
}
if (offset < 0) {
- if (-offset > (int)blen)
+ if (-offset > (SSize_t)blen)
DIE(aTHX_ "Offset outside string");
offset += blen;
}
offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
}
more_bytes:
- bufsize = SvCUR(bufsv);
+ orig_size = SvCUR(bufsv);
/* Allocating length + offset + 1 isn't perfect in the case of reading
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
unduly.
(should be 2 * length + offset + 1, or possibly something longer if
PL_encoding is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
- if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */
- Zero(buffer+bufsize, offset-bufsize, char);
+ if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
+ Zero(buffer+orig_size, offset-orig_size, char);
}
buffer = buffer + offset;
if (!buffer_utf8) {
else
#ifdef HAS_SOCKET__bad_code_maybe
if (IoTYPE(io) == IoTYPE_SOCKET) {
+ Sock_size_t bufsize;
char namebuf[MAXPATHLEN];
#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
bufsize = sizeof (struct sockaddr_in);
/* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
SETERRNO(0,0);
{
+ SV * const sv = POPs;
int result = 1;
GV *tmpgv;
IO *io;
- if (PL_op->op_flags & OPf_SPECIAL) {
- tmpgv = gv_fetchsv(POPs, 0, SVt_PVIO);
-
- do_ftruncate_gv:
+ if ((tmpgv = PL_op->op_flags & OPf_SPECIAL
+ ? gv_fetchsv(sv, 0, SVt_PVIO)
+ : MAYBE_DEREF_GV(sv) )) {
io = GvIO(tmpgv);
if (!io)
result = 0;
}
}
}
- else {
- SV * const sv = POPs;
- const char *name;
-
- if (isGV_with_GP(sv)) {
- tmpgv = MUTABLE_GV(sv); /* *main::FRED for example */
- goto do_ftruncate_gv;
- }
- else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
- tmpgv = MUTABLE_GV(SvRV(sv)); /* \*main::FRED for example */
- goto do_ftruncate_gv;
- }
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
io = MUTABLE_IO(SvRV(sv)); /* *main::FRED{IO} for example */
goto do_ftruncate_io;
- }
-
- name = SvPV_nolen_const(sv);
+ }
+ else {
+ const char * const name = SvPV_nomg_const_nolen(sv);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
IO *io;
I32 gimme;
I32 max = 13;
+ SV* sv;
- if (PL_op->op_flags & OPf_REF) {
- gv = cGVOP_gv;
+ if (PL_op->op_flags & OPf_REF ? (gv = cGVOP_gv, 1)
+ : !!(sv=POPs, gv = MAYBE_DEREF_GV(sv))) {
if (PL_op->op_type == OP_LSTAT) {
if (gv != PL_defgv) {
do_fstat_warning_check:
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
+ "lstat() on filehandle %"SVf, SVfARG(gv
+ ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
+ : &PL_sv_no));
} else if (PL_laststype != OP_LSTAT)
+ /* diag_listed_as: The stat preceding %s wasn't an lstat */
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
- do_fstat:
if (gv != PL_defgv) {
PL_laststype = OP_STAT;
PL_statgv = gv;
}
}
else {
- SV* const sv = POPs;
- if (isGV_with_GP(sv)) {
- gv = MUTABLE_GV(sv);
- goto do_fstat;
- } else if(SvROK(sv) && isGV_with_GP(SvRV(sv))) {
- gv = MUTABLE_GV(SvRV(sv));
- if (PL_op->op_type == OP_LSTAT)
- goto do_fstat_warning_check;
- goto do_fstat;
- } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
io = MUTABLE_IO(SvRV(sv));
if (PL_op->op_type == OP_LSTAT)
goto do_fstat_warning_check;
goto do_fstat_have_io;
}
- sv_setpv(PL_statname, SvPV_nolen_const(sv));
+ sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
PL_statgv = NULL;
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
#define tryAMAGICftest_MG(chr) STMT_START { \
if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
+ && PL_op->op_flags & OPf_KIDS \
&& S_try_amagic_ftest(aTHX_ chr)) \
return NORMAL; \
} STMT_END
assert(chr != '?');
SvGETMAGIC(arg);
- if ((PL_op->op_flags & OPf_KIDS)
- && SvAMAGIC(TOPs))
+ if (SvAMAGIC(TOPs))
{
const char tmpchr = chr;
SV * const tmpsv = amagic_call(arg,
I32 result;
tryAMAGICftest_MG('l');
+ STACKED_FTEST_CHECK;
result = my_lstat_flags(0);
SPAGAIN;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV_with_GP(TOPs))
- gv = MUTABLE_GV(POPs);
- else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
- gv = MUTABLE_GV(SvRV(POPs));
- else {
+ else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) {
tmpsv = POPs;
name = SvPV_nomg(tmpsv, namelen);
gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV_with_GP(TOPs))
- gv = MUTABLE_GV(POPs);
- else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
- gv = MUTABLE_GV(SvRV(POPs));
- else
- gv = NULL;
+ else gv = MAYBE_DEREF_GV_nomg(TOPs);
if (gv) {
EXTEND(SP, 1);
if (PL_op->op_flags & OPf_SPECIAL) {
gv = gv_fetchsv(sv, 0, SVt_PVIO);
}
- else if (isGV_with_GP(sv)) {
- gv = MUTABLE_GV(sv);
- }
- else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
- gv = MUTABLE_GV(SvRV(sv));
- }
- else {
- tmps = SvPV_nolen_const(sv);
- }
+ else if (!(gv = MAYBE_DEREF_GV(sv)))
+ tmps = SvPV_nomg_const_nolen(sv);
}
if( !gv && (!tmps || !*tmps) ) {
if ((IoIFP(io) || IoOFP(io)))
Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening filehandle %s also as a directory",
- GvENAME(gv));
+ "Opening filehandle %"HEKf" also as a directory",
+ HEKfARG(GvENAME_HEK(gv)) );
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
+ "readdir() attempted on invalid dirhandle %"HEKf,
+ HEKfARG(GvENAME_HEK(gv)));
goto nope;
}
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
+ "telldir() attempted on invalid dirhandle %"HEKf,
+ HEKfARG(GvENAME_HEK(gv)));
goto nope;
}
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
+ "seekdir() attempted on invalid dirhandle %"HEKf,
+ HEKfARG(GvENAME_HEK(gv)));
goto nope;
}
(void)PerlDir_seek(IoDIRP(io), along);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
+ "rewinddir() attempted on invalid dirhandle %"HEKf,
+ HEKfARG(GvENAME_HEK(gv)));
goto nope;
}
(void)PerlDir_rewind(IoDIRP(io));
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
- "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
+ "closedir() attempted on invalid dirhandle %"HEKf,
+ HEKfARG(GvENAME_HEK(gv)));
goto nope;
}
#ifdef VOID_CLOSEDIR
https://perl5.git.perl.org / perl5.git / blobdiff