X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=469a9dac4709a5a3a996ed2c26503e8e6b419595;hb=9758931364444385e32f6e1abf2e6aba4ddbd236;hp=f9321b37369fea03ce0baaf1e9094262419cb6a0;hpb=1129b882ced9d5881a47214405219a2e6e332a92;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index f9321b3..469a9da 100644 --- a/util.c +++ b/util.c @@ -9,8 +9,10 @@ */ /* - * "Very useful, no doubt, that was to Saruman; yet it seems that he was - * not content." --Gandalf + * 'Very useful, no doubt, that was to Saruman; yet it seems that he was + * not content.' --Gandalf to Pippin + * + * [p.598 of _The Lord of the Rings_, III/xi: "The Palantír"] */ /* This file contains assorted utility routines. @@ -274,12 +276,12 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) if (size && (count <= MEM_SIZE_MAX / size)) total_size = size * count; else - Perl_croak_nocontext(PL_memory_wrap); + Perl_croak_nocontext("%s", PL_memory_wrap); #ifdef PERL_TRACK_MEMPOOL if (sTHX <= MEM_SIZE_MAX - (MEM_SIZE)total_size) total_size += sTHX; else - Perl_croak_nocontext(PL_memory_wrap); + Perl_croak_nocontext("%s", PL_memory_wrap); #endif #ifdef HAS_64K_LIMIT if (total_size > 0xffff) { @@ -1243,7 +1245,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) if (PL_stderrgv && SvREFCNT(PL_stderrgv) && (io = GvIO(PL_stderrgv)) - && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { dSP; ENTER; @@ -1257,7 +1259,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) PUSHMARK(SP); EXTEND(SP,2); - PUSHs(SvTIED_obj((SV*)io, mg)); + PUSHs(SvTIED_obj(MUTABLE_SV(io), mg)); mPUSHp(message, msglen); PUTBACK; call_method("PRINT", G_SCALAR); @@ -1269,14 +1271,14 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) else { #ifdef USE_SFIO /* SFIO can really mess with your errno */ - const int e = errno; + dSAVED_ERRNO; #endif PerlIO * const serr = Perl_error_log; PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); (void)PerlIO_flush(serr); #ifdef USE_SFIO - errno = e; + RESTORE_ERRNO; #endif } } @@ -1324,7 +1326,7 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn) PUSHMARK(SP); XPUSHs(msg); PUTBACK; - call_sv((SV*)cv, G_DISCARD); + call_sv(MUTABLE_SV(cv), G_DISCARD); POPSTACK; LEAVE; return TRUE; @@ -1360,8 +1362,8 @@ S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen, return message; } -OP * -Perl_vdie(pTHX_ const char* pat, va_list *args) +static OP * +S_vdie(pTHX_ const char* pat, va_list *args) { dVAR; const char *message; @@ -1452,7 +1454,7 @@ sidestepping the normal C order of execution. See C. If you want to throw an exception object, assign the object to C<$@> and then pass C to croak(): - errsv = get_sv("@", TRUE); + errsv = get_sv("@", GV_ADD); sv_setsv(errsv, exception_object); croak(NULL); @@ -1665,9 +1667,16 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) #ifndef PERL_USE_SAFE_PUTENV if (!PL_use_safe_putenv) { /* most putenv()s leak, so we manipulate environ directly */ - register I32 i=setenv_getix(nam); /* where does it go? */ + register I32 i; + register const I32 len = strlen(nam); int nlen, vlen; + /* where does it go? */ + for (i = 0; environ[i]; i++) { + if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') + break; + } + if (environ == PL_origenviron) { /* need we copy environment? */ I32 j; I32 max; @@ -1771,30 +1780,6 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) #endif /* WIN32 || NETWARE */ -#ifndef PERL_MICRO -I32 -Perl_setenv_getix(pTHX_ const char *nam) -{ - register I32 i; - register const I32 len = strlen(nam); - - PERL_ARGS_ASSERT_SETENV_GETIX; - PERL_UNUSED_CONTEXT; - - for (i = 0; environ[i]; i++) { - if ( -#ifdef WIN32 - strnicmp(environ[i],nam,len) == 0 -#else - strnEQ(environ[i],nam,len) -#endif - && environ[i][len] == '=') - break; /* strnEQ must come first to avoid */ - } /* potential SEGV's */ - return i; -} -#endif /* !PERL_MICRO */ - #endif /* !VMS && !EPOC*/ #ifdef UNLINK_ALL_VERSIONS @@ -2270,7 +2255,7 @@ Perl_my_swabn(void *ptr, int n) PerlIO * Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) { -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) dVAR; int p[2]; register I32 This, that; @@ -2303,6 +2288,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } return NULL; } + if (ckWARN(WARN_PIPE)) + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); sleep(5); } if (pid == 0) { @@ -2360,9 +2347,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) else PerlLIO_close(p[that]); /* close child's end of pipe */ - LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,p[This],TRUE); - UNLOCK_FDPID_MUTEX; SvUPGRADE(sv,SVt_IV); SvIV_set(sv, pid); PL_forkprocess = pid; @@ -2408,7 +2393,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } /* VMS' my_popen() is in VMS.c, same with OS/2. */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) PerlIO * Perl_my_popen(pTHX_ const char *cmd, const char *mode) { @@ -2448,9 +2433,11 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) PerlLIO_close(pp[1]); } if (!doexec) - Perl_croak(aTHX_ "Can't fork"); + Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno)); return NULL; } + if (ckWARN(WARN_PIPE)) + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); sleep(5); } if (pid == 0) { @@ -2528,9 +2515,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) else PerlLIO_close(p[that]); - LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,p[This],TRUE); - UNLOCK_FDPID_MUTEX; SvUPGRADE(sv,SVt_IV); SvIV_set(sv, pid); PL_forkprocess = pid; @@ -2711,11 +2696,6 @@ dup2(int oldfd, int newfd) #ifndef PERL_MICRO #ifdef HAS_SIGACTION -#ifdef MACOS_TRADITIONAL -/* We don't want restart behavior on MacOS */ -#undef SA_RESTART -#endif - Sighandler_t Perl_rsignal(pTHX_ int signo, Sighandler_t handler) { @@ -2866,7 +2846,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #endif /* !PERL_MICRO */ /* VMS' my_pclose() is in VMS.c; same with OS/2 */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { @@ -2877,14 +2857,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) Pid_t pid; Pid_t pid2; bool close_failed; - int saved_errno = 0; -#ifdef WIN32 - int saved_win32_errno; -#endif + dSAVEDERRNO; - LOCK_FDPID_MUTEX; svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE); - UNLOCK_FDPID_MUTEX; pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1; SvREFCNT_dec(*svp); *svp = &PL_sv_undef; @@ -2893,12 +2868,8 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) return my_syspclose(ptr); } #endif - if ((close_failed = (PerlIO_close(ptr) == EOF))) { - saved_errno = errno; -#ifdef WIN32 - saved_win32_errno = GetLastError(); -#endif - } + close_failed = (PerlIO_close(ptr) == EOF); + SAVE_ERRNO; #ifdef UTS if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ #endif @@ -2916,7 +2887,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) rsignal_restore(SIGQUIT, &qstat); #endif if (close_failed) { - SETERRNO(saved_errno, 0); + RESTORE_ERRNO; return -1; } return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status)); @@ -2931,7 +2902,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) #endif #endif /* !DOSISH */ -#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE)) && !defined(__LIBCATAMOUNT__) I32 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) { @@ -3018,7 +2989,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) #ifdef PERL_USES_PL_PIDSTATUS void -Perl_pidgone(pTHX_ Pid_t pid, int status) +S_pidgone(pTHX_ Pid_t pid, int status) { register SV *sv; @@ -3108,13 +3079,13 @@ Perl_same_dirent(pTHX_ const char *a, const char *b) if (strNE(a,b)) return FALSE; if (fa == a) - sv_setpvn(tmpsv, ".", 1); + sv_setpvs(tmpsv, "."); else sv_setpvn(tmpsv, a, fa - a); if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf1) < 0) return FALSE; if (fb == b) - sv_setpvn(tmpsv, ".", 1); + sv_setpvs(tmpsv, "."); else sv_setpvn(tmpsv, b, fb - b); if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf2) < 0) @@ -3249,26 +3220,16 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, } #endif -#ifdef MACOS_TRADITIONAL - if (dosearch && !strchr(scriptname, ':') && - (s = PerlEnv_getenv("Commands"))) -#else if (dosearch && !strchr(scriptname, '/') #ifdef DOSISH && !strchr(scriptname, '\\') #endif && (s = PerlEnv_getenv("PATH"))) -#endif { bool seen_dot = 0; bufend = s + strlen(s); while (s < bufend) { -#ifdef MACOS_TRADITIONAL - s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend, - ',', - &len); -#else #if defined(atarist) || defined(DOSISH) for (len = 0; *s # ifdef atarist @@ -3285,15 +3246,10 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, ':', &len); #endif /* ! (atarist || DOSISH) */ -#endif /* MACOS_TRADITIONAL */ if (s < bufend) s++; if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) continue; /* don't search dir with too-long name */ -#ifdef MACOS_TRADITIONAL - if (len && tmpbuf[len - 1] != ':') - tmpbuf[len++] = ':'; -#else if (len # if defined(atarist) || defined(__MINT__) || defined(DOSISH) && tmpbuf[len - 1] != '/' @@ -3303,7 +3259,6 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, tmpbuf[len++] = '/'; if (len == 2 && tmpbuf[0] == '.') seen_dot = 1; -#endif (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len); #endif /* !VMS */ @@ -3328,7 +3283,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, continue; if (S_ISREG(PL_statbuf.st_mode) && cando(S_IRUSR,TRUE,&PL_statbuf) -#if !defined(DOSISH) && !defined(MACOS_TRADITIONAL) +#if !defined(DOSISH) && cando(S_IXUSR,TRUE,&PL_statbuf) #endif ) @@ -4120,6 +4075,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv) for (;;) { DIR *dir; + int namelen; odev = cdev; oino = cino; @@ -4142,9 +4098,9 @@ Perl_getcwd_sv(pTHX_ register SV *sv) while ((dp = PerlDir_read(dir)) != NULL) { #ifdef DIRNAMLEN - const int namelen = dp->d_namlen; + namelen = dp->d_namlen; #else - const int namelen = strlen(dp->d_name); + namelen = strlen(dp->d_name); #endif /* skip . and .. */ if (SV_CWD_ISDOT(dp)) { @@ -4305,11 +4261,11 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) pos = s; if ( qv ) - (void)hv_stores((HV *)hv, "qv", newSViv(qv)); + (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv)); if ( alpha ) - (void)hv_stores((HV *)hv, "alpha", newSViv(alpha)); + (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha)); if ( !qv && width < 3 ) - (void)hv_stores((HV *)hv, "width", newSViv(width)); + (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width)); while (isDIGIT(*pos)) pos++; @@ -4403,7 +4359,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) Compiler in question is: gcc version 3.3 20030304 (Apple Computer, Inc. build 1640) for ( len = 2 - len; len > 0; len-- ) - av_push((AV *)sv, newSViv(0)); + av_push(MUTABLE_AV(sv), newSViv(0)); */ len = 2 - len; while (len-- > 0) @@ -4413,8 +4369,8 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) /* need to save off the current version string for later */ if ( vinf ) { SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1); - (void)hv_stores((HV *)hv, "original", orig); - (void)hv_stores((HV *)hv, "vinf", newSViv(1)); + (void)hv_stores(MUTABLE_HV(hv), "original", orig); + (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1)); } else if ( s > start ) { SV * orig = newSVpvn(start,s-start); @@ -4422,15 +4378,15 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) /* need to insert a v to be consistent */ sv_insert(orig, 0, 0, "v", 1); } - (void)hv_stores((HV *)hv, "original", orig); + (void)hv_stores(MUTABLE_HV(hv), "original", orig); } else { - (void)hv_stores((HV *)hv, "original", newSVpvn("0",1)); + (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0")); av_push(av, newSViv(0)); } /* And finally, store the AV in the hash */ - (void)hv_stores((HV *)hv, "version", newRV_noinc((SV *)av)); + (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av))); /* fix RT#19517 - special case 'undef' as string */ if ( *s == 'u' && strEQ(s,"undef") ) { @@ -4472,25 +4428,25 @@ Perl_new_version(pTHX_ SV *ver) ver = SvRV(ver); /* Begin copying all of the elements */ - if ( hv_exists((HV *)ver, "qv", 2) ) - (void)hv_stores((HV *)hv, "qv", newSViv(1)); + if ( hv_exists(MUTABLE_HV(ver), "qv", 2) ) + (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1)); - if ( hv_exists((HV *)ver, "alpha", 5) ) - (void)hv_stores((HV *)hv, "alpha", newSViv(1)); + if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) ) + (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1)); - if ( hv_exists((HV*)ver, "width", 5 ) ) + if ( hv_exists(MUTABLE_HV(ver), "width", 5 ) ) { - const I32 width = SvIV(*hv_fetchs((HV*)ver, "width", FALSE)); - (void)hv_stores((HV *)hv, "width", newSViv(width)); + const I32 width = SvIV(*hv_fetchs(MUTABLE_HV(ver), "width", FALSE)); + (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width)); } - if ( hv_exists((HV*)ver, "original", 8 ) ) + if ( hv_exists(MUTABLE_HV(ver), "original", 8 ) ) { - SV * pv = *hv_fetchs((HV*)ver, "original", FALSE); - (void)hv_stores((HV *)hv, "original", newSVsv(pv)); + SV * pv = *hv_fetchs(MUTABLE_HV(ver), "original", FALSE); + (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(pv)); } - sav = (AV *)SvRV(*hv_fetchs((HV*)ver, "version", FALSE)); + sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE))); /* This will get reblessed later if a derived class*/ for ( key = 0; key <= av_len(sav); key++ ) { @@ -4498,7 +4454,7 @@ Perl_new_version(pTHX_ SV *ver) av_push(av, newSViv(rev)); } - (void)hv_stores((HV *)hv, "version", newRV_noinc((SV *)av)); + (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av))); return rv; } #ifdef SvVOK @@ -4646,8 +4602,8 @@ Perl_vverify(pTHX_ SV *vs) /* see if the appropriate elements exist */ if ( SvTYPE(vs) == SVt_PVHV - && hv_exists((HV*)vs, "version", 7) - && (sv = SvRV(*hv_fetchs((HV*)vs, "version", FALSE))) + && hv_exists(MUTABLE_HV(vs), "version", 7) + && (sv = SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) && SvTYPE(sv) == SVt_PVAV ) return TRUE; else @@ -4686,16 +4642,16 @@ Perl_vnumify(pTHX_ SV *vs) Perl_croak(aTHX_ "Invalid version object"); /* see if various flags exist */ - if ( hv_exists((HV*)vs, "alpha", 5 ) ) + if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) ) alpha = TRUE; - if ( hv_exists((HV*)vs, "width", 5 ) ) - width = SvIV(*hv_fetchs((HV*)vs, "width", FALSE)); + if ( hv_exists(MUTABLE_HV(vs), "width", 5 ) ) + width = SvIV(*hv_fetchs(MUTABLE_HV(vs), "width", FALSE)); else width = 3; /* attempt to retrieve the version array */ - if ( !(av = (AV *)SvRV(*hv_fetchs((HV*)vs, "version", FALSE)) ) ) { + if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) { sv_catpvs(sv,"0"); return sv; } @@ -4766,9 +4722,9 @@ Perl_vnormal(pTHX_ SV *vs) if ( !vverify(vs) ) Perl_croak(aTHX_ "Invalid version object"); - if ( hv_exists((HV*)vs, "alpha", 5 ) ) + if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) ) alpha = TRUE; - av = (AV *)SvRV(*hv_fetchs((HV*)vs, "version", FALSE)); + av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))); len = av_len(av); if ( len == -1 ) @@ -4822,16 +4778,16 @@ Perl_vstringify(pTHX_ SV *vs) if ( !vverify(vs) ) Perl_croak(aTHX_ "Invalid version object"); - if (hv_exists((HV*)vs, "original", sizeof("original") - 1)) { + if (hv_exists(MUTABLE_HV(vs), "original", sizeof("original") - 1)) { SV *pv; - pv = *hv_fetchs((HV*)vs, "original", FALSE); + pv = *hv_fetchs(MUTABLE_HV(vs), "original", FALSE); if ( SvPOK(pv) ) return newSVsv(pv); else return &PL_sv_undef; } else { - if ( hv_exists((HV *)vs, "qv", 2) ) + if ( hv_exists(MUTABLE_HV(vs), "qv", 2) ) return vnormal(vs); else return vnumify(vs); @@ -4871,13 +4827,13 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv) Perl_croak(aTHX_ "Invalid version object"); /* get the left hand term */ - lav = (AV *)SvRV(*hv_fetchs((HV*)lhv, "version", FALSE)); - if ( hv_exists((HV*)lhv, "alpha", 5 ) ) + lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE))); + if ( hv_exists(MUTABLE_HV(lhv), "alpha", 5 ) ) lalpha = TRUE; /* and the right hand term */ - rav = (AV *)SvRV(*hv_fetchs((HV*)rhv, "version", FALSE)); - if ( hv_exists((HV*)rhv, "alpha", 5 ) ) + rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE))); + if ( hv_exists(MUTABLE_HV(rhv), "alpha", 5 ) ) ralpha = TRUE; l = av_len(lav); @@ -5067,12 +5023,12 @@ S_socketpair_udp (int fd[2]) { errno = ECONNABORTED; tidy_up_and_fail: { - const int save_errno = errno; + dSAVE_ERRNO; if (sockets[0] != -1) PerlLIO_close(sockets[0]); if (sockets[1] != -1) PerlLIO_close(sockets[1]); - errno = save_errno; + RESTORE_ERRNO; return -1; } } @@ -5171,14 +5127,14 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { #endif tidy_up_and_fail: { - const int save_errno = errno; + dSAVE_ERRNO; if (listener != -1) PerlLIO_close(listener); if (connector != -1) PerlLIO_close(connector); if (acceptor != -1) PerlLIO_close(acceptor); - errno = save_errno; + RESTORE_ERRNO; return -1; } } @@ -5586,7 +5542,7 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const cha (void)time(&when); # endif /* If there are other OS specific ways of hires time than - * gettimeofday() (see ext/Time/HiRes), the easiest way is + * gettimeofday() (see ext/Time-HiRes), the easiest way is * probably that they would be used to fill in the struct * timeval. */ # endif @@ -6005,10 +5961,11 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || strEQ(GvNAME(gv), "END") || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ - !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) { + !( (SvTYPE(*svp) == SVt_PVGV) + && (GvCV((const GV *)*svp) == cv) )))) { /* Use GV from the stack as a fallback. */ /* GV is potentially non-unique, or contain different CV. */ - SV * const tmp = newRV((SV*)cv); + SV * const tmp = newRV(MUTABLE_SV(cv)); sv_setsv(dbsv, tmp); SvREFCNT_dec(tmp); } @@ -6050,7 +6007,7 @@ Perl_get_re_arg(pTHX_ SV *sv) { if (SvMAGICAL(sv)) mg_get(sv); if (SvROK(sv) && - (tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */ + (tmpsv = MUTABLE_SV(SvRV(sv))) && /* assign deliberate */ SvTYPE(tmpsv) == SVt_REGEXP) { return (REGEXP*) tmpsv;