{
dVAR;
OP *result;
- tryAMAGICunTARGET(iter, -1);
+ dSP;
+ /* make a copy of the pattern, to ensure that magic is called once
+ * and only once */
+ TOPm1s = sv_2mortal(newSVsv(TOPm1s));
+
+ tryAMAGICunTARGET(iter_amg, -1, (PL_op->op_flags & OPf_SPECIAL));
+
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ /* call Perl-level glob function instead. Stack args are:
+ * MARK, wildcard, csh_glob context index
+ * and following OPs should be: gv(CORE::GLOBAL::glob), entersub
+ * */
+ return NORMAL;
+ }
+ /* stack args are: wildcard, gv(_GEN_n) */
+
/* Note that we only ever get here if File::Glob fails to load
* without at the same time croaking, for some reason, or if
/* I/O. */
+/* These are private to this function, which is private to this file.
+ Use 0x04 rather than the next available bit, to help the compiler if the
+ architecture can generate more efficient instructions. */
+#define MORTALIZE_NOT_NEEDED 0x04
+#define ARGUMENTS_ON_STACK 0x08
+
+static OP *
+S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
+ IO *const io, const MAGIC *const mg, const U32 flags,
+ U32 argc, ...)
+{
+ PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
+
+ /* Ensure that our flag bits do not overlap. */
+ assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ assert((ARGUMENTS_ON_STACK & G_WANT) == 0);
+
+ PUSHMARK(sp);
+ PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
+ if (flags & ARGUMENTS_ON_STACK)
+ sp += argc;
+ else if (argc) {
+ const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
+ va_list args;
+ va_start(args, argc);
+ do {
+ SV *const arg = va_arg(args, SV *);
+ if(mortalize_not_needed)
+ PUSHs(arg);
+ else
+ mPUSHs(arg);
+ } while (--argc);
+ va_end(args);
+ }
+
+ PUTBACK;
+ ENTER_with_name("call_tied_handle_method");
+ call_method(methname, flags & G_WANT);
+ LEAVE_with_name("call_tied_handle_method");
+ return NORMAL;
+}
+
+#define tied_handle_method(a,b,c,d) \
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,0)
+#define tied_handle_method1(a,b,c,d,e) \
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,1,e)
+#define tied_handle_method2(a,b,c,d,e,f) \
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f)
+
PP(pp_open)
{
dVAR; dSP;
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
- MAGIC *mg;
+ const MAGIC *mg;
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
if (IoDIRP(io))
if (mg) {
/* Method's args are same as ours ... */
/* ... except handle is replaced by the object */
- *MARK-- = SvTIED_obj(MUTABLE_SV(io), mg);
- PUSHMARK(MARK);
- PUTBACK;
- ENTER_with_name("call_OPEN");
- call_method("OPEN", G_SCALAR);
- LEAVE_with_name("call_OPEN");
- return NORMAL;
+ return S_tied_handle_method(aTHX_ "OPEN", mark - 1, io, mg,
+ G_SCALAR | ARGUMENTS_ON_STACK,
+ sp - mark);
}
}
RETURN;
}
-/* These are private to this function, which is private to this file.
- Use 0x04 rather than the next available bit, to help the compiler if the
- architecture can generate more efficient instructions. */
-#define MORTALIZE_NOT_NEEDED 0x04
-#define TIED_HANDLE_ARGC_SHIFT 3
-
-static OP *
-S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
- IO *const io, MAGIC *const mg, const U32 flags, ...)
-{
- U32 argc = flags >> TIED_HANDLE_ARGC_SHIFT;
-
- PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
-
- /* Ensure that our flag bits do not overlap. */
- assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
- assert((G_WANT >> TIED_HANDLE_ARGC_SHIFT) == 0);
-
- PUSHMARK(sp);
- PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
- if (argc) {
- const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
- va_list args;
- va_start(args, flags);
- do {
- SV *const arg = va_arg(args, SV *);
- if(mortalize_not_needed)
- PUSHs(arg);
- else
- mPUSHs(arg);
- } while (--argc);
- va_end(args);
- }
-
- PUTBACK;
- ENTER_with_name("call_tied_handle_method");
- call_method(methname, flags & G_WANT);
- LEAVE_with_name("call_tied_handle_method");
- return NORMAL;
-}
-
-#define tied_handle_method(a,b,c,d) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR)
-#define tied_handle_method1(a,b,c,d,e) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (1 << TIED_HANDLE_ARGC_SHIFT),e)
-#define tied_handle_method2(a,b,c,d,e,f) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f)
-
PP(pp_close)
{
dVAR; dSP;
if (gv) {
IO * const io = GvIO(gv);
if (io) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
return tied_handle_method("CLOSE", SP, io, mg);
}
GV *gv;
IO *io;
PerlIO *fp;
- MAGIC *mg;
+ const MAGIC *mg;
if (MAXARG < 1)
RETPUSHUNDEF;
gv = MUTABLE_GV(POPs);
+ io = GvIO(gv);
- if (gv && (io = GvIO(gv))
+ if (io
&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
{
return tied_handle_method("FILENO", SP, io, mg);
}
- if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+ if (!io || !(fp = IoIFP(io))) {
/* Can't do this because people seem to do things like
defined(fileno($foo)) to check whether $foo is a valid fh.
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+
+ report_evil_fh(gv);
*/
RETPUSHUNDEF;
}
}
gv = MUTABLE_GV(POPs);
+ io = GvIO(gv);
- if (gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ if (io) {
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
/* This takes advantage of the implementation of the varargs
function, which I don't think that the optimiser will be able to
figure out. Although, as it's a static function, in theory it
could. */
return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
- G_SCALAR|MORTALIZE_NOT_NEEDED
- | (discp
- ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
- discp);
+ G_SCALAR|MORTALIZE_NOT_NEEDED,
+ discp ? 1 : 0, discp);
}
}
- if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (!io || !(fp = IoIFP(io))) {
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
PP(pp_getc)
{
dVAR; dSP; dTARGET;
- IO *io = NULL;
GV * const gv = (MAXARG==0) ? PL_stdingv : MUTABLE_GV(POPs);
+ IO *const io = GvIO(gv);
if (MAXARG == 0)
EXTEND(SP, 1);
- if (gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ if (io) {
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
const U32 gimme = GIMME_V;
- S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme);
+ S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme, 0);
if (gimme == G_SCALAR) {
SPAGAIN;
SvSetMagicSV_nosteal(TARG, TOPs);
}
}
if (!gv || do_eof(gv)) { /* make sure we have fp with something */
- if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
- && ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
fp = IoOFP(io);
if (!fp) {
- if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- if (IoIFP(io))
- report_wrongway_fh(gv, '<');
- else if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
- }
+ if (IoIFP(io))
+ report_wrongway_fh(gv, '<');
+ else
+ report_evil_fh(gv);
PUSHs(&PL_sv_no);
}
else {
PP(pp_prtf)
{
dVAR; dSP; dMARK; dORIGMARK;
- IO *io;
PerlIO *fp;
SV *sv;
GV * const gv
= (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
+ IO *const io = GvIO(gv);
- if (gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ if (io) {
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
++SP;
}
- PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
- PUTBACK;
- ENTER;
- call_method("PRINTF", G_SCALAR);
- LEAVE;
- return NORMAL;
+ return S_tied_handle_method(aTHX_ "PRINTF", mark - 1, io, mg,
+ G_SCALAR | ARGUMENTS_ON_STACK,
+ sp - mark);
}
}
sv = newSV(0);
- if (!(io = GvIO(gv))) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (!io) {
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
- if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- if (IoIFP(io))
- report_wrongway_fh(gv, '<');
- else if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
- }
+ if (IoIFP(io))
+ report_wrongway_fh(gv, '<');
+ else if (ckWARN(WARN_CLOSED))
+ report_evil_fh(gv);
SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
goto just_say_no;
}
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
&& gv && (io = GvIO(gv)) )
{
- const MAGIC * mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
- PUSHMARK(MARK-1);
- *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
- ENTER;
- call_method("READ", G_SCALAR);
- LEAVE;
- return NORMAL;
+ return S_tied_handle_method(aTHX_ "READ", mark - 1, io, mg,
+ G_SCALAR | ARGUMENTS_ON_STACK,
+ sp - mark);
}
}
offset = 0;
io = GvIO(gv);
if (!io || !IoIFP(io)) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
count = -1;
}
if (count < 0) {
- if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
+ if (IoTYPE(io) == IoTYPE_WRONLY)
report_wrongway_fh(gv, '>');
goto say_undef;
}
GV *const gv = MUTABLE_GV(*++MARK);
if (PL_op->op_type == OP_SYSWRITE
&& gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
if (MARK == SP - 1) {
SV *sv = *SP;
PUTBACK;
}
- PUSHMARK(ORIGMARK);
- *(ORIGMARK+1) = SvTIED_obj(MUTABLE_SV(io), mg);
- ENTER;
- call_method("WRITE", G_SCALAR);
- LEAVE;
- return NORMAL;
+ return S_tied_handle_method(aTHX_ "WRITE", mark - 1, io, mg,
+ G_SCALAR | ARGUMENTS_ON_STACK,
+ sp - mark);
}
}
if (!gv)
io = GvIO(gv);
if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) {
retval = -1;
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
- if (io && IoIFP(io))
- report_wrongway_fh(gv, '<');
- else
- report_evil_fh(gv, io, PL_op->op_type);
- }
+ if (io && IoIFP(io))
+ report_wrongway_fh(gv, '<');
+ else
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
dVAR; dSP;
GV *gv;
IO *io;
- MAGIC *mg;
+ const MAGIC *mg;
/*
* in Perl 5.12 and later, the additional parameter is a bitmask:
* 0 = eof
EXTEND(SP, 1);
gv = PL_last_in_gv;
- if (gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ io = GvIO(gv);
+ if (io) {
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
return tied_handle_method("TELL", SP, io, mg);
}
#endif
GV * const gv = PL_last_in_gv = MUTABLE_GV(POPs);
- IO *io;
+ IO *const io = GvIO(gv);
- if (gv && (io = GvIO(gv))) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ if (io) {
+ const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
#if LSEEKSIZE > IVSIZE
SV *const offset_sv = newSVnv((NV) offset);
tmpgv = gv_fetchsv(POPs, 0, SVt_PVIO);
do_ftruncate_gv:
- if (!GvIO(tmpgv))
+ io = GvIO(tmpgv);
+ if (!io)
result = 0;
else {
PerlIO *fp;
- io = GvIOp(tmpgv);
do_ftruncate_io:
TAINT_PROPER("truncate");
if (!(fp = IoIFP(io))) {
IV retval;
if (!io || !argsv || !IoIFP(io)) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI); /* well, sort of... */
RETPUSHUNDEF;
}
#ifdef FLOCK
dVAR; dSP; dTARGET;
I32 value;
- IO *io = NULL;
- PerlIO *fp;
const int argtype = POPi;
GV * const gv = (MAXARG == 0) ? PL_last_in_gv : MUTABLE_GV(POPs);
+ IO *const io = GvIO(gv);
+ PerlIO *const fp = io ? IoIFP(io) : NULL;
- if (gv && (io = GvIO(gv)))
- fp = IoIFP(io);
- else {
- fp = NULL;
- io = NULL;
- }
/* XXX Looks to me like io is always NULL at this point */
if (fp) {
(void)PerlIO_flush(fp);
value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
else {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
value = 0;
SETERRNO(EBADF,RMS_IFI);
}
register IO * const io = gv ? GvIOn(gv) : NULL;
int fd;
- if (!gv || !io) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (!io) {
+ report_evil_fh(gv);
if (io && IoIFP(io))
do_close(gv, FALSE);
SETERRNO(EBADF,LIB_INVARG);
register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
int fd[2];
- if (!gv1 || !gv2 || !io1 || !io2) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
- if (!gv1 || !io1)
- report_evil_fh(gv1, io1, PL_op->op_type);
- if (!gv2 || !io2)
- report_evil_fh(gv2, io2, PL_op->op_type);
- }
- }
+ if (!io1)
+ report_evil_fh(gv1);
+ if (!io2)
+ report_evil_fh(gv2);
if (io1 && IoIFP(io1))
do_close(gv1, FALSE);
GV * const gv = MUTABLE_GV(POPs);
register IO * const io = GvIOn(gv);
STRLEN len;
+ const int op_type = PL_op->op_type;
if (!io || !IoIFP(io))
goto nuts;
addr = SvPV_const(addrsv, len);
- TAINT_PROPER("bind");
- if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
- RETPUSHYES;
- else
- RETPUSHUNDEF;
-
-nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,SS_IVCHAN);
- RETPUSHUNDEF;
-#else
- DIE(aTHX_ PL_no_sock_func, "bind");
-#endif
-}
-
-PP(pp_connect)
-{
-#ifdef HAS_SOCKET
- dVAR; dSP;
- SV * const addrsv = POPs;
- GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
- const char *addr;
- STRLEN len;
-
- if (!io || !IoIFP(io))
- goto nuts;
-
- addr = SvPV_const(addrsv, len);
- TAINT_PROPER("connect");
- if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+ TAINT_PROPER(PL_op_desc[op_type]);
+ if ((op_type == OP_BIND
+ ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
+ : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len))
+ >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(aTHX_ PL_no_sock_func, "connect");
+ DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
#endif
}
GV * const gv = MUTABLE_GV(POPs);
register IO * const io = gv ? GvIOn(gv) : NULL;
- if (!gv || !io || !IoIFP(io))
+ if (!io || !IoIFP(io))
goto nuts;
if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
RETPUSHUNDEF;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
#else
RETURN;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
+ report_evil_fh(ggv);
SETERRNO(EBADF,SS_IVCHAN);
badexit:
RETURN;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
#else
RETURN;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, optype);
+ report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
nuts2:
RETPUSHUNDEF;
RETURN;
nuts:
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, optype);
+ report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
nuts2:
RETPUSHUNDEF;
}
if (PL_laststatval < 0) {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, GvIO(gv), PL_op->op_type);
+ report_evil_fh(gv);
max = 0;
}
}
len = 512;
}
else {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
- gv = cGVOP_gv;
- report_evil_fh(gv, GvIO(gv), PL_op->op_type);
- }
+ report_evil_fh(cGVOP_gv);
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
}
else {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF, RMS_IFI);
PUSHi(0);
}
}
else {
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
PUSHi(0);
}
https://perl5.git.perl.org / perl5.git / blobdiff