develooper Front page | perl.perl5.porters | Postings from November 2008

Re: [PATCH] standardize save/restore of errno & vaxc$errno

Thread Previous | Thread Next
From:
Steve Peters
Date:
November 27, 2008 07:33
Subject:
Re: [PATCH] standardize save/restore of errno & vaxc$errno
Message ID:
fd7a59d30811270733jb3d9a61v34dee4266264f2@mail.gmail.com
On Thu, Nov 27, 2008 at 1:01 AM, Chip Salzenberg <chip@pobox.com> wrote:
> The fix for bug #1154 will require saving and restoring errno, and I've
> found that this basic and nonportable operation had not been standardized.
> So here's a patch to do that.
>
> Win32 note: my_pclose() was saving the result of GetLastError(), but was
> not using it; in particular it was not calling SetLastError(), which one
> might have expected it to do.  Would a Win32 expert care to weigh in?
>
> VMS note: I have no VMS system, and this patch could break something if
> vaxc$errno doesn't work as documented online and/or I haven't grokked it
> properly.  Some smoke testing would be appropriate.
>
> Share & Enjoy!
>
> diff --git a/perl.h b/perl.h
> index d08a4a6..30b64f1 100644
> --- a/perl.h
> +++ b/perl.h
> @@ -1277,6 +1277,11 @@ EXTERN_C char *crypt(const char *, const char *);
>            set_errno(errcode);         \
>            set_vaxc_errno(vmserrcode); \
>        } STMT_END
> +#   define dSAVEDERRNO    int saved_errno; unsigned saved_vms_errno
> +#   define dSAVE_ERRNO    int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno
> +#   define SAVE_ERRNO     ( saved_errno = errno, saved_vms_errno = vaxc$errno )
> +#   define RESTORE_ERRNO  SETERRNO(saved_errno, saved_vms_errno)
> +
>  #   define LIB_INVARG          LIB$_INVARG
>  #   define RMS_DIR             RMS$_DIR
>  #   define RMS_FAC             RMS$_FAC
> @@ -1291,6 +1296,11 @@ EXTERN_C char *crypt(const char *, const char *);
>  #   define SS_NORMAL           SS$_NORMAL
>  #else
>  #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
> +#   define dSAVEDERRNO    int saved_errno
> +#   define dSAVE_ERRNO    int saved_errno = errno
> +#   define SAVE_ERRNO     (saved_errno = errno)
> +#   define RESTORE_ERRNO  (errno = saved_errno)
> +
>  #   define LIB_INVARG          0
>  #   define RMS_DIR             0
>  #   define RMS_FAC             0
> diff --git a/doio.c b/doio.c
> index 2738323..c945216 100644
> --- a/doio.c
> +++ b/doio.c
> @@ -663,9 +663,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
>     }
>  #if defined(HAS_FCNTL) && defined(F_SETFD)
>     if (fd >= 0) {
> -       const int save_errno = errno;
> +       dSAVE_ERRNO;
>        fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
> -       errno = save_errno;
> +       RESTORE_ERRNO;
>     }
>  #endif
>     IoIFP(io) = fp;
> @@ -1014,14 +1014,14 @@ Perl_do_eof(pTHX_ GV *gv)
>
>        {
>             /* getc and ungetc can stomp on errno */
> -           const int saverrno = errno;
> +           dSAVE_ERRNO;
>            const int ch = PerlIO_getc(IoIFP(io));
>            if (ch != EOF) {
>                (void)PerlIO_ungetc(IoIFP(io),ch);
> -               errno = saverrno;
> +               RESTORE_ERRNO;
>                return FALSE;
>            }
> -           errno = saverrno;
> +           RESTORE_ERRNO;
>        }
>
>         if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
> diff --git a/mg.c b/mg.c
> index 6f4cc58..7acff51 100644
> --- a/mg.c
> +++ b/mg.c
> @@ -817,10 +817,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
>             }
>  #else
>             {
> -                const int saveerrno = errno;
> +                dSAVE_ERRNO;
>                 sv_setnv(sv, (NV)errno);
>                 sv_setpv(sv, errno ? Strerror(errno) : "");
> -                errno = saveerrno;
> +                RESTORE_ERRNO;
>             }
>  #endif
>             SvRTRIM(sv);
> @@ -1036,7 +1036,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
>        sv_setpv(sv, errno ? Strerror(errno) : "");
>  #else
>        {
> -       const int saveerrno = errno;
> +       dSAVE_ERRNO;
>        sv_setnv(sv, (NV)errno);
>  #ifdef OS2
>        if (errno == errno_isOS2 || errno == errno_isOS2_set)
> @@ -1044,7 +1044,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
>        else
>  #endif
>        sv_setpv(sv, errno ? Strerror(errno) : "");
> -       errno = saveerrno;
> +       RESTORE_ERRNO;
>        }
>  #endif
>        SvRTRIM(sv);
> diff --git a/perlio.c b/perlio.c
> index a3ea344..95c3b24 100644
> --- a/perlio.c
> +++ b/perlio.c
> @@ -3131,8 +3131,8 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
>         const int fd = fileno(stdio);
>        int invalidate = 0;
>        IV result = 0;
> -       int saveerr = 0;
>        int dupfd = -1;
> +       dSAVEDERRNO;
>  #ifdef USE_ITHREADS
>        dVAR;
>  #endif
> @@ -3166,7 +3166,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
>               fileno slot of the FILE *
>            */
>            result = PerlIO_flush(f);
> -           saveerr = errno;
> +           SAVE_ERRNO;
>            invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
>            if (!invalidate) {
>  #ifdef USE_ITHREADS
> @@ -3205,7 +3205,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
>           errno may NOT be expected EBADF
>         */
>        if (invalidate && result != 0) {
> -           errno = saveerr;
> +           RESTORE_ERRNO;
>            result = 0;
>        }
>  #ifdef SOCKS5_VERSION_NAME
> @@ -3367,9 +3367,9 @@ PerlIOStdio_flush(pTHX_ PerlIO *f)
>        /*
>         * Not writeable - sync by attempting a seek
>         */
> -       const int err = errno;
> +       dSAVE_ERRNO;
>        if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
> -           errno = err;
> +           RESTORE_ERRNO;
>  #endif
>     }
>     return 0;
> diff --git a/pp_sys.c b/pp_sys.c
> index 11cd863..211633b 100644
> --- a/pp_sys.c
> +++ b/pp_sys.c
> @@ -5167,13 +5167,13 @@ PP(pp_gpwent)
>         * has a different API than the Solaris/IRIX one. */
>  #   if defined(HAS_GETSPNAM) && !defined(_AIX)
>        {
> -           const int saverrno = errno;
> +           dSAVE_ERRNO;
>            const struct spwd * const spwent = getspnam(pwent->pw_name);
>                          /* Save and restore errno so that
>                           * underprivileged attempts seem
>                           * to have never made the unsccessful
>                           * attempt to retrieve the shadow password. */
> -           errno = saverrno;
> +           RESTORE_ERRNO;
>            if (spwent && spwent->sp_pwdp)
>                sv_setpv(sv, spwent->sp_pwdp);
>        }
> @@ -5551,15 +5551,15 @@ static int
>  lockf_emulate_flock(int fd, int operation)
>  {
>     int i;
> -    const int save_errno = errno;
>     Off_t pos;
> +    dSAVE_ERRNO;
>
>     /* flock locks entire file so for lockf we need to do the same     */
>     pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR);    /* get pos to restore later */
>     if (pos > 0)       /* is seekable and needs to be repositioned     */
>        if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)
>            pos = -1;   /* seek failed, so don't seek back afterwards   */
> -    errno = save_errno;
> +    RESTORE_ERRNO;
>
>     switch (operation) {
>
> diff --git a/sv.c b/sv.c
> index efa347b..a86994a 100644
> --- a/sv.c
> +++ b/sv.c
> @@ -2958,7 +2958,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
>        *s = '\0';
>     }
>     else if (SvNOKp(sv)) {
> -       const int olderrno = errno;
> +       dSAVE_ERRNO;
>        if (SvTYPE(sv) < SVt_PVNV)
>            sv_upgrade(sv, SVt_PVNV);
>        /* The +20 is pure guesswork.  Configure test needed. --jhi */
> @@ -2972,7 +2972,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
>        {
>            Gconvert(SvNVX(sv), NV_DIG, 0, s);
>        }
> -       errno = olderrno;
> +       RESTORE_ERRNO;
>  #ifdef FIXNEGATIVEZERO
>         if (*s == '-' && s[1] == '0' && !s[2]) {
>            s[0] = '0';
> diff --git a/util.c b/util.c
> index aebc8ef..b94aa0e 100644
> --- a/util.c
> +++ b/util.c
> @@ -1271,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
>     }
>  }
> @@ -2879,10 +2879,7 @@ 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);
> @@ -2895,12 +2892,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
> -    }
> +    if ((close_failed = (PerlIO_close(ptr) == EOF)))
> +       SAVE_ERRNO;
>  #ifdef UTS
>     if(PerlProc_kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
>  #endif
> @@ -2918,7 +2911,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));
> @@ -5069,12 +5062,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;
>     }
>  }
> @@ -5173,14 +5166,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;
>     }
>  }
> diff --git a/vms/vms.c b/vms/vms.c
> index e674a8a..b5b8a7d 100644
> --- a/vms/vms.c
> +++ b/vms/vms.c
> @@ -11912,10 +11912,10 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
>     char temp_fspec[VMS_MAXRSS];
>     char *save_spec;
>     int retval = -1;
> -    int saved_errno, saved_vaxc_errno;
> +    dSAVEDERRNO;
>
>     if (!fspec) return retval;
> -    saved_errno = errno; saved_vaxc_errno = vaxc$errno;
> +    SAVE_ERRNO;
>     strcpy(temp_fspec, fspec);
>
>     if (decc_bug_devnull != 0) {
> @@ -12042,7 +12042,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
>  #     endif
>     }
>     /* If we were successful, leave errno where we found it */
> -    if (retval == 0) { errno = saved_errno; vaxc$errno = saved_vaxc_errno; }
> +    if (retval == 0) RESTORE_ERRNO;
>     return retval;
>
>  }  /* end of flex_stat_int() */
>
>

After I applied this patch locally, the following happened...

../ext/PerlIO/t/ioleaks                                      (Wstat: 0
Tests: 12 Failed: 0)
  TODO passed:   1, 4, 7-12
../lib/Attribute/Handlers/t/linerep                          (Wstat: 0
Tests: 18 Failed: 0)
  TODO passed:   16

I'll try a couple of other operating systems to see for certain.

Steve Peters
steve@fisharerojo.org

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About