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
Convert t/op/die_unwind.t to test.pl, strict and warnings.
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index 26129ab..30a2645 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -449,7 +449,9 @@ PP(pp_warn)
     else {
        exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
     }
-    warn_sv(exsv);
+    if (SvROK(exsv) && !PL_warnhook)
+        Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
+    else warn_sv(exsv);
     RETSETYES;
 }
 
@@ -1680,9 +1682,6 @@ PP(pp_sysread)
        PUSHs(TARG);
        RETURN;
     }
-#else
-    if (PL_op->op_type == OP_RECV)
-       DIE(aTHX_ PL_no_sock_func, "recv");
 #endif
     if (DO_UTF8(bufsv)) {
        /* offset adjust in characters not bytes */
@@ -1821,10 +1820,9 @@ PP(pp_sysread)
     RETPUSHUNDEF;
 }
 
-PP(pp_send)
+PP(pp_syswrite)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    IO *io;
     SV *bufsv;
     const char *buffer;
     SSize_t retval;
@@ -1833,10 +1831,10 @@ PP(pp_send)
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     U8 *tmpbuf = NULL;
-    
     GV *const gv = MUTABLE_GV(*++MARK);
-    if (PL_op->op_type == OP_SYSWRITE
-       && gv && (io = GvIO(gv))) {
+    IO *const io = GvIO(gv);
+
+    if (op_type == OP_SYSWRITE && io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            if (MARK == SP - 1) {
@@ -1856,7 +1854,6 @@ PP(pp_send)
     bufsv = *++MARK;
 
     SETERRNO(0,0);
-    io = GvIO(gv);
     if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) {
        retval = -1;
        if (io && IoIFP(io))
@@ -1894,7 +1891,23 @@ PP(pp_send)
        }
     }
 
-    if (op_type == OP_SYSWRITE) {
+#ifdef HAS_SOCKET
+    if (op_type == OP_SEND) {
+       const int flags = SvIVx(*++MARK);
+       if (SP > MARK) {
+           STRLEN mlen;
+           char * const sockbuf = SvPVx(*++MARK, mlen);
+           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+                                    flags, (struct sockaddr *)sockbuf, mlen);
+       }
+       else {
+           retval
+               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+       }
+    }
+    else
+#endif
+    {
        Size_t length = 0; /* This length is in characters.  */
        STRLEN blen_chars;
        IV offset;
@@ -1989,24 +2002,6 @@ PP(pp_send)
                                   buffer, length);
        }
     }
-#ifdef HAS_SOCKET
-    else {
-       const int flags = SvIVx(*++MARK);
-       if (SP > MARK) {
-           STRLEN mlen;
-           char * const sockbuf = SvPVx(*++MARK, mlen);
-           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
-                                    flags, (struct sockaddr *)sockbuf, mlen);
-       }
-       else {
-           retval
-               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
-       }
-    }
-#else
-    else
-       DIE(aTHX_ PL_no_sock_func, "send");
-#endif
 
     if (retval < 0)
        goto say_undef;
@@ -2370,9 +2365,10 @@ PP(pp_flock)
 
 /* Sockets. */
 
+#ifdef HAS_SOCKET
+
 PP(pp_socket)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int protocol = POPi;
     const int type = POPi;
@@ -2414,10 +2410,8 @@ PP(pp_socket)
 #endif
 
     RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_sock_func, "socket");
-#endif
 }
+#endif
 
 PP(pp_sockpair)
 {
@@ -2474,9 +2468,10 @@ PP(pp_sockpair)
 #endif
 }
 
+#ifdef HAS_SOCKET
+
 PP(pp_bind)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
@@ -2503,14 +2498,10 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-#endif
 }
 
 PP(pp_listen)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int backlog = POPi;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2528,14 +2519,10 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, "listen");
-#endif
 }
 
 PP(pp_accept)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP; dTARGET;
     register IO *nstio;
     register IO *gstio;
@@ -2606,14 +2593,10 @@ nuts:
 badexit:
     RETPUSHUNDEF;
 
-#else
-    DIE(aTHX_ PL_no_sock_func, "accept");
-#endif
 }
 
 PP(pp_shutdown)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP; dTARGET;
     const int how = POPi;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2629,14 +2612,10 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, "shutdown");
-#endif
 }
 
 PP(pp_ssockopt)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int optype = PL_op->op_type;
     SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
@@ -2705,14 +2684,10 @@ nuts:
 nuts2:
     RETPUSHUNDEF;
 
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-#endif
 }
 
 PP(pp_getpeername)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int optype = PL_op->op_type;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2767,11 +2742,9 @@ nuts:
     SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
+}
 
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
 
 /* Stat calls. */
 
@@ -4648,7 +4621,7 @@ PP(pp_shmwrite)
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget();
+    return Perl_pp_semget(aTHX);
 #endif
 }
 
@@ -4685,7 +4658,7 @@ PP(pp_semctl)
     }
     RETURN;
 #else
-    return pp_semget();
+    return Perl_pp_semget(aTHX);
 #endif
 }
 
@@ -4800,7 +4773,7 @@ PP(pp_ghostent)
     }
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "gethostent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -4873,7 +4846,7 @@ PP(pp_gnetent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getnetent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -4933,7 +4906,7 @@ PP(pp_gprotoent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getprotoent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -5008,100 +4981,110 @@ PP(pp_gservent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getservent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
 PP(pp_shostent)
 {
-#ifdef HAS_SETHOSTENT
     dVAR; dSP;
-    PerlSock_sethostent(TOPi);
-    RETSETYES;
+    const int stayopen = TOPi;
+    switch(PL_op->op_type) {
+    case OP_SHOSTENT:
+#ifdef HAS_SETHOSTENT
+       PerlSock_sethostent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "sethostent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_snetent)
-{
+       break;
 #ifdef HAS_SETNETENT
-    dVAR; dSP;
-    (void)PerlSock_setnetent(TOPi);
-    RETSETYES;
+    case OP_SNETENT:
+       PerlSock_setnetent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setnetent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_sprotoent)
-{
+       break;
+    case OP_SPROTOENT:
 #ifdef HAS_SETPROTOENT
-    dVAR; dSP;
-    (void)PerlSock_setprotoent(TOPi);
-    RETSETYES;
+       PerlSock_setprotoent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setprotoent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_sservent)
-{
+       break;
+    case OP_SSERVENT:
 #ifdef HAS_SETSERVENT
-    dVAR; dSP;
-    (void)PerlSock_setservent(TOPi);
-    RETSETYES;
+       PerlSock_setservent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setservent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
+       break;
+    }
+    RETSETYES;
 }
 
 PP(pp_ehostent)
 {
-#ifdef HAS_ENDHOSTENT
     dVAR; dSP;
-    PerlSock_endhostent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+    switch(PL_op->op_type) {
+    case OP_EHOSTENT:
+#ifdef HAS_ENDHOSTENT
+       PerlSock_endhostent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endhostent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_enetent)
-{
+       break;
+    case OP_ENETENT:
 #ifdef HAS_ENDNETENT
-    dVAR; dSP;
-    PerlSock_endnetent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endnetent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endnetent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_eprotoent)
-{
+       break;
+    case OP_EPROTOENT:
 #ifdef HAS_ENDPROTOENT
-    dVAR; dSP;
-    PerlSock_endprotoent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endprotoent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endprotoent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_eservent)
-{
+       break;
+    case OP_ESERVENT:
 #ifdef HAS_ENDSERVENT
-    dVAR; dSP;
-    PerlSock_endservent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endservent();
+#else
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_SGRENT:
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
+       setgrent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_EGRENT:
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
+       endgrent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_SPWENT:
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
+       setpwent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endservent");
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
 #endif
+       break;
+    case OP_EPWENT:
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
+       endpwent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    }
+    EXTEND(SP,1);
+    RETPUSHYES;
 }
 
 PP(pp_gpwent)
@@ -5337,28 +5320,6 @@ PP(pp_gpwent)
 #endif
 }
 
-PP(pp_spwent)
-{
-#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
-    dVAR; dSP;
-    setpwent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "setpwent");
-#endif
-}
-
-PP(pp_epwent)
-{
-#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
-    dVAR; dSP;
-    endpwent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "endpwent");
-#endif
-}
-
 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
@@ -5433,28 +5394,6 @@ PP(pp_ggrent)
 #endif
 }
 
-PP(pp_sgrent)
-{
-#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
-    dVAR; dSP;
-    setgrent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "setgrent");
-#endif
-}
-
-PP(pp_egrent)
-{
-#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
-    dVAR; dSP;
-    endgrent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "endgrent");
-#endif
-}
-
 PP(pp_getlogin)
 {
 #ifdef HAS_GETLOGIN
Unnamed repository; edit this file 'description' to name the repository.