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
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Now optimising for $a (reverse ...)
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index 10d0529..1f19fbd 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,7 +1,7 @@
 /*    pp_sys.c
  *
  *    Copyright (C) 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.
@@ -621,8 +621,8 @@ PP(pp_pipe_op)
     if (PerlProc_pipe(fd) < 0)
        goto badexit;
 
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
@@ -1327,7 +1327,7 @@ PP(pp_leavewrite)
            if (!IoTOP_NAME(io)) {
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
                topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpv("top",FALSE,SVt_PVFM))
@@ -1820,7 +1820,11 @@ PP(pp_send)
     }
 
     if (PerlIO_isutf8(IoIFP(io))) {
-       buffer = SvPVutf8(bufsv, blen);
+       if (!SvUTF8(bufsv)) {
+           bufsv = sv_2mortal(newSVsv(bufsv));
+           buffer = sv_2pvutf8(bufsv, &blen);
+       } else
+           buffer = SvPV(bufsv, blen);
     }
     else {
         if (DO_UTF8(bufsv)) {
@@ -2295,8 +2299,8 @@ PP(pp_socket)
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0)
        RETPUSHUNDEF;
-    IoIFP(io) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE);   /* stdio gets confused about sockets */
-    IoOFP(io) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+    IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
+    IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
@@ -2357,11 +2361,11 @@ PP(pp_sockpair)
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
-    IoIFP(io1) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
-    IoOFP(io1) = PerlIO_fdopen(fd[0], "w"PIPESOCK_MODE);
+    IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
+    IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
     IoTYPE(io1) = IoTYPE_SOCKET;
-    IoIFP(io2) = PerlIO_fdopen(fd[1], "r"PIPESOCK_MODE);
-    IoOFP(io2) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+    IoIFP(io2) = PerlIO_fdopen(fd[1], "r"SOCKET_OPEN_MODE);
+    IoOFP(io2) = PerlIO_fdopen(fd[1], "w"SOCKET_OPEN_MODE);
     IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
@@ -2532,8 +2536,8 @@ PP(pp_accept)
        goto badexit;
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
-    IoIFP(nstio) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE);
-    IoOFP(nstio) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+    IoIFP(nstio) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);
+    IoOFP(nstio) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2877,13 +2881,23 @@ PP(pp_stat)
     RETURN;
 }
 
+/* This macro is used by the stacked filetest operators :
+ * if the previous filetest failed, short-circuit and pass its value.
+ * Else, discard it from the stack and continue. --rgs
+ */
+#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
+       if (TOPs == &PL_sv_no || TOPs == &PL_sv_undef) { RETURN; } \
+       else { (void)POPs; PUTBACK; } \
+    }
+
 PP(pp_ftrread)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(R_OK)
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = access(POPpx, R_OK);
        if (result == 0)
            RETPUSHYES;
@@ -2908,9 +2922,10 @@ PP(pp_ftrwrite)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(W_OK)
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = access(POPpx, W_OK);
        if (result == 0)
            RETPUSHYES;
@@ -2935,9 +2950,10 @@ PP(pp_ftrexec)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(X_OK)
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = access(POPpx, X_OK);
        if (result == 0)
            RETPUSHYES;
@@ -2962,9 +2978,10 @@ PP(pp_fteread)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_R_OK
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = PERL_EFF_ACCESS_R_OK(POPpx);
        if (result == 0)
            RETPUSHYES;
@@ -2989,9 +3006,10 @@ PP(pp_ftewrite)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_W_OK
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = PERL_EFF_ACCESS_W_OK(POPpx);
        if (result == 0)
            RETPUSHYES;
@@ -3016,9 +3034,10 @@ PP(pp_fteexec)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_X_OK
-    STRLEN n_a;
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+       STRLEN n_a;
        result = PERL_EFF_ACCESS_X_OK(POPpx);
        if (result == 0)
            RETPUSHYES;
@@ -3041,8 +3060,11 @@ PP(pp_fteexec)
 
 PP(pp_ftis)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     RETPUSHYES;
@@ -3055,8 +3077,11 @@ PP(pp_fteowned)
 
 PP(pp_ftrowned)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
@@ -3067,8 +3092,11 @@ PP(pp_ftrowned)
 
 PP(pp_ftzero)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (PL_statcache.st_size == 0)
@@ -3078,8 +3106,11 @@ PP(pp_ftzero)
 
 PP(pp_ftsize)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
 #if Off_t_size > IVSIZE
@@ -3092,8 +3123,11 @@ PP(pp_ftsize)
 
 PP(pp_ftmtime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
@@ -3102,8 +3136,11 @@ PP(pp_ftmtime)
 
 PP(pp_ftatime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
@@ -3112,8 +3149,11 @@ PP(pp_ftatime)
 
 PP(pp_ftctime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
@@ -3122,8 +3162,11 @@ PP(pp_ftctime)
 
 PP(pp_ftsock)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISSOCK(PL_statcache.st_mode))
@@ -3133,8 +3176,11 @@ PP(pp_ftsock)
 
 PP(pp_ftchr)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISCHR(PL_statcache.st_mode))
@@ -3144,8 +3190,11 @@ PP(pp_ftchr)
 
 PP(pp_ftblk)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISBLK(PL_statcache.st_mode))
@@ -3155,8 +3204,11 @@ PP(pp_ftblk)
 
 PP(pp_ftfile)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISREG(PL_statcache.st_mode))
@@ -3166,8 +3218,11 @@ PP(pp_ftfile)
 
 PP(pp_ftdir)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISDIR(PL_statcache.st_mode))
@@ -3177,8 +3232,11 @@ PP(pp_ftdir)
 
 PP(pp_ftpipe)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISFIFO(PL_statcache.st_mode))
@@ -3201,7 +3259,9 @@ PP(pp_ftsuid)
 {
     dSP;
 #ifdef S_ISUID
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3215,7 +3275,9 @@ PP(pp_ftsgid)
 {
     dSP;
 #ifdef S_ISGID
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3229,7 +3291,9 @@ PP(pp_ftsvtx)
 {
     dSP;
 #ifdef S_ISVTX
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3247,6 +3311,8 @@ PP(pp_fttty)
     char *tmps = Nullch;
     STRLEN n_a;
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -3289,6 +3355,8 @@ PP(pp_fttext)
     STRLEN n_a;
     PerlIO *fp;
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     else if (isGV(TOPs))
Unnamed repository; edit this file 'description' to name the repository.