enable -ansi -pedantic

Message-ID: <20020917221925.GF85044@lyta.hut.fi>

p4raw-id: //depot/perl@17925

diff --git a/Configure b/Configure
index 815ad74..a879612 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -1117,6 +1117,7 @@ defvoidused=''
 voidflags=''
 pm_apiversion=''
 xs_apiversion=''
+gccansipedantic=''
 yacc=''
 yaccflags=''
 CONFIG=''
@@ -20620,6 +20621,7 @@ vi='$vi'
 voidflags='$voidflags'
 xlibpth='$xlibpth'
 xs_apiversion='$xs_apiversion'
+gccansipedantic='$gccansipedantic'
 yacc='$yacc'
 yaccflags='$yaccflags'
 zcat='$zcat'

diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod
index cff54cd..0146f68 100644 (file)
--- a/Porting/pumpkin.pod
+++ b/Porting/pumpkin.pod
@@ -769,6 +769,44 @@ clean up, and print warnings from the log files
 
 (-Wformat support by Robin Barker.)
 
+=item gcc -ansi -pedantic
+
+Configure -Dgccansipedantic [ -Dcc=gcc ] will enable (via the cflags script,
+not $Config{ccflags}) the gcc strict ANSI C flags -ansi and -pedantic for
+the compilation of the core files on platforms where it knows it can
+do so (like Linux, see cflags.SH for the full list), and on some
+platforms only one (Solaris can do only -pedantic, not -ansi).
+The flag -DPERL_GCC_PEDANTIC also gets added, since gcc does not add
+any internal cpp flag to signify that -pedantic is being used, as it
+does for -ansi (__STRICT_ANSI__).
+
+The -ansi and -pedantic are useful in catching at least the following
+nonportable practices:
+
+=over 4
+
+=item *
+
+gcc-specific extensions
+
+=item *
+
+lvalue casts
+
+=item *
+
+// C++ comments
+
+=item *
+
+enum trailing commas
+
+=back
+
+The -Dgccansipedantic should be used only when cleaning up the code,
+not for production builds, since otherwise gcc cannot inline certain
+things.
+
 =back
 
 =head1 Running Purify

diff --git a/cflags.SH b/cflags.SH
index 3ee7c5f..453fff6 100755 (executable)
--- a/cflags.SH
+++ b/cflags.SH
@@ -123,18 +123,39 @@ for file do
     *) ;;
     esac
 
-# Add -Wall for the core and core modules iff gcc and not already -Wall
+# Add -Wall for the core modules iff gcc and not already -Wall
 warn=''
 case "$gccversion" in
 '') ;;
 *)  case "$ccflags" in
     *-Wall*) ;;
-# Can't add -ansi here because it will fail e.g. in Solaris.
+    *) warn="$warn -Wall" ;;
+    esac
+    case "$gccansipedantic" in
+    define)
+        case "$osname" in
+       # Add -ansi -pedantic only for known platforms.
+        aix|dec_osf|freebsd|hpux|irix|linux)
+           ansipedantic="-ansi -pedantic" ;;
+        solaris)
+# Can't add -ansi for Solaris.
 # Off_t/off_t is a struct in Solaris with largefiles, and with -ansi
 # that struct cannot be compared with a flat integer, such as a STRLEN.
 # The -ansi will also cause a lot of noise in Solaris because of:
 # /usr/include/sys/resource.h:148: warning: `struct rlimit64' declared inside parameter list
-    *) warn='-Wall' ;;
+           ansipedantic="-pedantic" ;;
+       esac
+       for i in $ansipedantic
+       do
+           case "$ccflags" in
+           *$i*) ;;
+           *) warn="$warn $i" ;;
+           esac
+       done
+        case "$warn$ccflags" in
+        *-pedantic*) warn="$warn -DPERL_GCC_PEDANTIC" ;;
+        esac
+        ;;
     esac
     ;;
 esac

diff --git a/doio.c b/doio.c
index 01d485b..a706fbf 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -218,7 +218,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                if (ckWARN(WARN_IO))
                    Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Can't open a reference");
-               SETERRNO(EINVAL, LIB$_INVARG);
+               SETERRNO(EINVAL, LIB_INVARG);
                goto say_false;
            }
 #endif /* USE_STDIO */
@@ -345,7 +345,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        }
                        if (!thatio) {
 #ifdef EINVAL
-                           SETERRNO(EINVAL,SS$_IVCHAN);
+                           SETERRNO(EINVAL,SS_IVCHAN);
 #endif
                            goto say_false;
                        }
@@ -954,7 +954,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
        gv = PL_argvgv;
     if (!gv || SvTYPE(gv) != SVt_PVGV) {
        if (not_implicit)
-           SETERRNO(EBADF,SS$_IVCHAN);
+           SETERRNO(EBADF,SS_IVCHAN);
        return FALSE;
     }
     io = GvIO(gv);
@@ -962,7 +962,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
        if (not_implicit) {
            if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
                report_evil_fh(gv, io, PL_op->op_type);
-           SETERRNO(EBADF,SS$_IVCHAN);
+           SETERRNO(EBADF,SS_IVCHAN);
        }
        return FALSE;
     }
@@ -1006,7 +1006,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
        IoOFP(io) = IoIFP(io) = Nullfp;
     }
     else if (not_implicit) {
-       SETERRNO(EBADF,SS$_IVCHAN);
+       SETERRNO(EBADF,SS_IVCHAN);
     }
 
     return retval;
@@ -1067,7 +1067,7 @@ Perl_do_tell(pTHX_ GV *gv)
     }
     if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,RMS$_IFI);
+    SETERRNO(EBADF,RMS_IFI);
     return (Off_t)-1;
 }
 
@@ -1086,7 +1086,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
     }
     if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,RMS$_IFI);
+    SETERRNO(EBADF,RMS_IFI);
     return FALSE;
 }
 
@@ -1100,7 +1100,7 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
        return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
     if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,RMS$_IFI);
+    SETERRNO(EBADF,RMS_IFI);
     return (Off_t)-1;
 }
 
@@ -2089,7 +2089,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     opbuf = SvPV(opstr, opsize);
     if (opsize < 3 * SHORTSIZE
        || (opsize % (3 * SHORTSIZE))) {
-       SETERRNO(EINVAL,LIB$_INVARG);
+       SETERRNO(EINVAL,LIB_INVARG);
        return -1;
     }
     SETERRNO(0,0);
@@ -2146,7 +2146,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     if (shmctl(id, IPC_STAT, &shmds) == -1)
        return -1;
     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
-       SETERRNO(EFAULT,SS$_ACCVIO);            /* can't do as caller requested */
+       SETERRNO(EFAULT,SS_ACCVIO);             /* can't do as caller requested */
        return -1;
     }
     shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
@@ -2273,7 +2273,7 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
            }
            if (cxt) (void)lib$find_file_end(&cxt);
            if (ok && sts != RMS$_NMF &&
-               sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
+               sts != RMS$_DNF && sts != RMS_FNF) ok = 0;
            if (!ok) {
                if (!(sts & 1)) {
                    SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);

diff --git a/mg.c b/mg.c
index 4432429..25f4585 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2062,8 +2062,15 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
+        {
+#ifdef VMS
+#   define PERL_VMS_BANG vaxc$errno
+#else
+#   define PERL_VMS_BANG 0
+#endif
        SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
-                (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
+                (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG);
+       }
        break;
     case '<':
        PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);

diff --git a/perl.c b/perl.c
index d295455..2f2e4f5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1526,7 +1526,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     /* now parse the script */
 
-    SETERRNO(0,SS$_NORMAL);
+    SETERRNO(0,SS_NORMAL);
     PL_error_count = 0;
 #ifdef MACOS_TRADITIONAL
     if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) {

diff --git a/perl.h b/perl.h
index 1c17d31..d5d849a 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -228,12 +228,12 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  * Trying to select a version that gives no warnings...
  */
 #if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
+# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) && !defined(__cplusplus)
 #   define STMT_START  (void)( /* gcc supports ``({ STATEMENTS; })'' */
 #   define STMT_END    )
 # else
    /* Now which other defined()s do we need here ??? */
-#  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
+#  if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
 #   define STMT_START  if (1)
 #   define STMT_END    else (void)0
 #  else
@@ -730,8 +730,32 @@ int sockatmark(int);
            set_errno(errcode);         \
            set_vaxc_errno(vmserrcode); \
        } STMT_END
+#   define LIB_INVARG          LIB$_INVARG
+#   define RMS_DIR             RMS$_DIR
+#   define RMS_FAC             RMS$_FAC
+#   define RMS_FEX             RMS$_FEX
+#   define RMS_FNF             RMS$_FNF
+#   define RMS_IFI             RMS$_IFI
+#   define RMS_ISI             RMS$_ISI
+#   define RMS_PRV             RMS$_PRV
+#   define SS_ACCVIO           SS$_ACCVIO
+#   define SS_DEVOFFLINE       SS$_DEVOFFLINE
+#   define SS_IVCHAN           SS$_IVCHAN
+#   define SS_NORMAL           SS$_NORMAL
 #else
 #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
+#   define LIB_INVARG          0
+#   define RMS_DIR             0
+#   define RMS_FAC             0
+#   define RMS_FEX             0
+#   define RMS_FNF             0
+#   define RMS_IFI             0
+#   define RMS_ISI             0
+#   define RMS_PRV             0
+#   define SS_ACCVIO           0
+#   define SS_DEVOFFLINE       0
+#   define SS_IVCHAN           0
+#   define SS_NORMAL           0
 #endif
 
 #ifdef USE_5005THREADS
@@ -3882,7 +3906,7 @@ typedef struct am_table_short AMTS;
  * Remap printf
  */
 #undef printf
-#ifdef __GNUC__
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
 #define printf(fmt,args...) PerlIO_stdoutf(fmt,##args)
 #else
 #define printf PerlIO_stdoutf

diff --git a/perlio.c b/perlio.c
index 11f600f..e645f84 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -214,7 +214,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
        return NULL;
     }
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
     }
 #endif
     return NULL;
@@ -481,7 +481,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
        return new;
     }
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return NULL;
     }
 }
@@ -812,7 +812,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                        Perl_warner(aTHX_ packWARN(WARN_LAYER),
                              "perlio: invalid separator character %c%c%c in layer specification list %s",
                              q, *s, q, s);
-                   SETERRNO(EINVAL, LIB$_INVARG);
+                   SETERRNO(EINVAL, LIB_INVARG);
                    return -1;
                }
                do {
@@ -1223,7 +1223,7 @@ PerlIO__close(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1247,7 +1247,7 @@ Perl_PerlIO_fileno(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1448,7 +1448,7 @@ Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1459,7 +1459,7 @@ Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1470,7 +1470,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1481,7 +1481,7 @@ Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1492,7 +1492,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1508,13 +1508,13 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
            }
            else {
                PerlIO_debug("Cannot flush f=%p :%s\n", (void*)f, tab->name);
-               SETERRNO(EBADF, SS$_IVCHAN);
+               SETERRNO(EBADF, SS_IVCHAN);
                return -1;
            }
        }
        else {
            PerlIO_debug("Cannot flush f=%p\n", (void*)f);
-           SETERRNO(EBADF, SS$_IVCHAN);
+           SETERRNO(EBADF, SS_IVCHAN);
            return -1;
        }
     }
@@ -1566,7 +1566,7 @@ Perl_PerlIO_fill(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1577,7 +1577,7 @@ PerlIO_isutf8(PerlIO *f)
     if (PerlIOValid(f))
        return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1588,7 +1588,7 @@ Perl_PerlIO_eof(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1599,7 +1599,7 @@ Perl_PerlIO_error(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1610,7 +1610,7 @@ Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        (*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
     else
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
 }
 
 void
@@ -1619,7 +1619,7 @@ Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        (*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
     else
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
 }
 
 int
@@ -1907,7 +1907,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
            l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE;
            break;
        default:
-           SETERRNO(EINVAL, LIB$_INVARG);
+           SETERRNO(EINVAL, LIB_INVARG);
            return -1;
        }
        while (*mode) {
@@ -1922,7 +1922,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
                l->flags |= PERLIO_F_CRLF;
                break;
            default:
-               SETERRNO(EINVAL, LIB$_INVARG);
+               SETERRNO(EINVAL, LIB_INVARG);
                return -1;
            }
        }
@@ -2233,7 +2233,7 @@ PerlIOUnix_oflags(const char *mode)
      */
     oflags |= O_BINARY;
     if (*mode || oflags == -1) {
-       SETERRNO(EINVAL, LIB$_INVARG);
+       SETERRNO(EINVAL, LIB_INVARG);
        oflags = -1;
     }
     return oflags;
@@ -2401,7 +2401,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
        }
     }
     else {
-       SETERRNO(EBADF,SS$_IVCHAN);
+       SETERRNO(EBADF,SS_IVCHAN);
        return -1;
     }
     while (PerlLIO_close(fd) != 0) {
@@ -4061,7 +4061,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
                if (!page_size) {
 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
                    {
-                       SETERRNO(0, SS$_NORMAL);
+                       SETERRNO(0, SS_NORMAL);
 #   ifdef _SC_PAGESIZE
                        page_size = sysconf(_SC_PAGESIZE);
 #   else
@@ -4580,7 +4580,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
        if (f && len == sizeof(Off_t))
            return PerlIO_seek(f, *posn, SEEK_SET);
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #else
@@ -4600,7 +4600,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 #endif
        }
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #endif

diff --git a/pp_ctl.c b/pp_ctl.c
index 336e002..67fcbf2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3221,7 +3221,7 @@ PP(pp_require)
        RETPUSHUNDEF;
     }
     else
-       SETERRNO(0, SS$_NORMAL);
+       SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
     len = strlen(name);

diff --git a/pp_hot.c b/pp_hot.c
index f0d3e98..98b9b44 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -607,7 +607,7 @@ PP(pp_print)
             goto had_magic;
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
-       SETERRNO(EBADF,RMS$_IFI);
+       SETERRNO(EBADF,RMS_IFI);
        goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
@@ -617,7 +617,7 @@ PP(pp_print)
            else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
                report_evil_fh(gv, io, PL_op->op_type);
        }
-       SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+       SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
        goto just_say_no;
     }
     else {

diff --git a/pp_sys.c b/pp_sys.c
index 9f15b0e..d1dacdd 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1447,7 +1447,7 @@ PP(pp_prtf)
     if (!(io = GvIO(gv))) {
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
-       SETERRNO(EBADF,RMS$_IFI);
+       SETERRNO(EBADF,RMS_IFI);
        goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
@@ -1469,7 +1469,7 @@ PP(pp_prtf)
            else if (ckWARN(WARN_CLOSED))
                report_evil_fh(gv, io, PL_op->op_type);
        }
-       SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+       SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
        goto just_say_no;
     }
     else {
@@ -2121,7 +2121,7 @@ PP(pp_truncate)
        if (result)
            RETPUSHYES;
        if (!errno)
-           SETERRNO(EBADF,RMS$_IFI);
+           SETERRNO(EBADF,RMS_IFI);
        RETPUSHUNDEF;
     }
 #else
@@ -2148,7 +2148,7 @@ PP(pp_ioctl)
     if (!io || !argsv || !IoIFP(io)) {
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
-       SETERRNO(EBADF,RMS$_IFI);       /* well, sort of... */
+       SETERRNO(EBADF,RMS_IFI);        /* well, sort of... */
        RETPUSHUNDEF;
     }
 
@@ -2236,7 +2236,7 @@ PP(pp_flock)
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
        value = 0;
-       SETERRNO(EBADF,RMS$_IFI);
+       SETERRNO(EBADF,RMS_IFI);
     }
     PUSHi(value);
     RETURN;
@@ -2266,7 +2266,7 @@ PP(pp_socket)
            report_evil_fh(gv, io, PL_op->op_type);
        if (IoIFP(io))
            do_close(gv, FALSE);
-       SETERRNO(EBADF,LIB$_INVARG);
+       SETERRNO(EBADF,LIB_INVARG);
        RETPUSHUNDEF;
     }
 
@@ -2417,7 +2417,7 @@ PP(pp_bind)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
@@ -2447,7 +2447,7 @@ PP(pp_connect)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
@@ -2473,7 +2473,7 @@ PP(pp_listen)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
@@ -2540,7 +2540,7 @@ PP(pp_accept)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 
 badexit:
     RETPUSHUNDEF;
@@ -2567,7 +2567,7 @@ PP(pp_shutdown)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
@@ -2646,7 +2646,7 @@ PP(pp_ssockopt)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, optype);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
@@ -2719,7 +2719,7 @@ PP(pp_getpeername)
 nuts:
     if (ckWARN(WARN_CLOSED))
        report_evil_fh(gv, io, optype);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
@@ -3325,7 +3325,7 @@ PP(pp_fttext)
                gv = cGVOP_gv;
                report_evil_fh(gv, GvIO(gv), PL_op->op_type);
            }
-           SETERRNO(EBADF,RMS$_IFI);
+           SETERRNO(EBADF,RMS_IFI);
            RETPUSHUNDEF;
        }
     }
@@ -3654,21 +3654,21 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
 #define EACCES EPERM
 #endif
            if (instr(s, "cannot make"))
-               SETERRNO(EEXIST,RMS$_FEX);
+               SETERRNO(EEXIST,RMS_FEX);
            else if (instr(s, "existing file"))
-               SETERRNO(EEXIST,RMS$_FEX);
+               SETERRNO(EEXIST,RMS_FEX);
            else if (instr(s, "ile exists"))
-               SETERRNO(EEXIST,RMS$_FEX);
+               SETERRNO(EEXIST,RMS_FEX);
            else if (instr(s, "non-exist"))
-               SETERRNO(ENOENT,RMS$_FNF);
+               SETERRNO(ENOENT,RMS_FNF);
            else if (instr(s, "does not exist"))
-               SETERRNO(ENOENT,RMS$_FNF);
+               SETERRNO(ENOENT,RMS_FNF);
            else if (instr(s, "not empty"))
-               SETERRNO(EBUSY,SS$_DEVOFFLINE);
+               SETERRNO(EBUSY,SS_DEVOFFLINE);
            else if (instr(s, "cannot access"))
-               SETERRNO(EACCES,RMS$_PRV);
+               SETERRNO(EACCES,RMS_PRV);
            else
-               SETERRNO(EPERM,RMS$_PRV);
+               SETERRNO(EPERM,RMS_PRV);
            return 0;
        }
        else {  /* some mkdirs return no failure indication */
@@ -3678,7 +3678,7 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
            if (anum)
                SETERRNO(0,0);
            else
-               SETERRNO(EACCES,RMS$_PRV);      /* a guess */
+               SETERRNO(EACCES,RMS_PRV);       /* a guess */
        }
        return anum;
     }
@@ -3772,7 +3772,7 @@ PP(pp_open_dir)
     RETPUSHYES;
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_DIR);
+       SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
@@ -3827,7 +3827,7 @@ PP(pp_readdir)
 
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_ISI);
+       SETERRNO(EBADF,RMS_ISI);
     if (GIMME == G_ARRAY)
        RETURN;
     else
@@ -3858,7 +3858,7 @@ PP(pp_telldir)
     RETURN;
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_ISI);
+       SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
@@ -3881,7 +3881,7 @@ PP(pp_seekdir)
     RETPUSHYES;
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_ISI);
+       SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
@@ -3902,7 +3902,7 @@ PP(pp_rewinddir)
     RETPUSHYES;
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_ISI);
+       SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
@@ -3932,7 +3932,7 @@ PP(pp_closedir)
     RETPUSHYES;
 nope:
     if (!errno)
-       SETERRNO(EBADF,RMS$_IFI);
+       SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");

diff --git a/sv.h b/sv.h
index 94366fe..acdadba 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -152,7 +152,7 @@ perform the upgrade if necessary.  See C<svtype>.
 #  define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0))
 #endif /* USE_5005THREADS */
 
-#ifdef __GNUC__
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
 #  define SvREFCNT_inc(sv)             \
     ({                                 \
        SV *nsv = (SV*)(sv);            \
@@ -1000,7 +1000,7 @@ otherwise.
 #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp)
 #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp)
 
-#ifdef __GNUC__
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
 
 #  define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); })
 #  define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); })

diff --git a/toke.c b/toke.c
index fa0f1ac..c60a929 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1963,7 +1963,7 @@ S_incl_perldb(pTHX)
 
        if (pdb)
            return pdb;
-       SETERRNO(0,SS$_NORMAL);
+       SETERRNO(0,SS_NORMAL);
        return "BEGIN { require 'perl5db.pl' }";
     }
     return "";

diff --git a/util.c b/util.c
index 4901d90..bd7ba2d 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3307,7 +3307,7 @@ Perl_my_fflush_all(pTHX)
       return 0;
     }
 #  endif
-    SETERRNO(EBADF,RMS$_IFI);
+    SETERRNO(EBADF,RMS_IFI);
     return EOF;
 # endif
 #endif