blead 25801: Symbian batch of today

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index caa58d3..102a8bd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -347,7 +347,7 @@ perl_construct(pTHXx)
 #   endif
        if ((long) PL_mmap_page_size < 0) {
          if (errno) {
-           SV *error = ERRSV;
+           SV * const error = ERRSV;
            (void) SvUPGRADE(error, SVt_PV);
            Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
          }
@@ -546,7 +546,7 @@ perl_destruct(pTHXx)
 
     if (CALL_FPTR(PL_threadhook)(aTHX)) {
         /* Threads hook has vetoed further cleanup */
-        return STATUS_NATIVE_EXPORT;
+        return STATUS_EXIT;
     }
 
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
@@ -768,7 +768,7 @@ perl_destruct(pTHXx)
 #endif
 
        /* The exit() function will do everything that needs doing. */
-        return STATUS_NATIVE_EXPORT;
+        return STATUS_EXIT;
     }
 
     /* jettison our possibly duplicated environment */
@@ -1085,15 +1085,15 @@ perl_destruct(pTHXx)
         */
        I32 riter = 0;
        const I32 max = HvMAX(PL_strtab);
-       HE **array = HvARRAY(PL_strtab);
+       HE ** const array = HvARRAY(PL_strtab);
        HE *hent = array[0];
 
        for (;;) {
            if (hent && ckWARN_d(WARN_INTERNAL)) {
-               HE *next = HeNEXT(hent);
+               HE * const next = HeNEXT(hent);
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Unbalanced string table refcount: (%d) for \"%s\"",
-                    HeVAL(hent) - Nullsv, HeKEY(hent));
+                    "Unbalanced string table refcount: (%ld) for \"%s\"",
+                    (long)(HeVAL(hent) - Nullsv), HeKEY(hent));
                Safefree(hent);
                hent = next;
            }
@@ -1259,7 +1259,7 @@ perl_destruct(pTHXx)
        Safefree(PL_mess_sv);
        PL_mess_sv = Nullsv;
     }
-    return STATUS_NATIVE_EXPORT;
+    return STATUS_EXIT;
 }
 
 /*
@@ -1555,7 +1555,7 @@ setuid perl scripts securely.\n");
        PL_curstash = PL_defstash;
        if (PL_checkav)
            call_list(oldscope, PL_checkav);
-       ret = STATUS_NATIVE_EXPORT;
+       ret = STATUS_EXIT;
        break;
     case 3:
        PerlIO_printf(Perl_error_log, "panic: top_env\n");
@@ -1767,6 +1767,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PERL_OLD_COPY_ON_WRITE
                             " PERL_OLD_COPY_ON_WRITE"
 #  endif
+#  ifdef PERL_USE_SAFE_PUTENV
+                            " PERL_USE_SAFE_PUTENV"
+#  endif
 #  ifdef PL_OP_SLAB_ALLOC
                             " PL_OP_SLAB_ALLOC"
 #  endif
@@ -1934,7 +1937,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                d = s;
                if (!*s)
                    break;
-               if (!strchr("DIMUdmtwA", *s))
+               if (!strchr("CDIMUdmtwA", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -2067,7 +2070,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
      * or explicitly in some platforms.
      * locale.c:Perl_init_i18nl10n() if the environment
      * look like the user wants to use UTF-8. */
-#if defined(SYMBIAN)
+#if defined(__SYMBIAN32__)
     PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
 #endif
     if (PL_unicode) {
@@ -2215,7 +2218,7 @@ perl_run(pTHXx)
        if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
            dump_mstats("after execution:  ");
 #endif
-       ret = STATUS_NATIVE_EXPORT;
+       ret = STATUS_EXIT;
        break;
     case 3:
        if (PL_restartop) {
@@ -2880,7 +2883,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
        for (; isALNUM(**s); (*s)++) ;
     }
     else if (givehelp) {
-      char **p = (char **)usage_msgd;
+      const char *const *p = usage_msgd;
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
 #  ifdef EBCDIC
@@ -3084,8 +3087,8 @@ Perl_moreswitches(pTHX_ char *s)
            PL_preambleav = newAV();
        s++;
        {
-           char *start = s;
-           SV *sv = newSVpv("use assertions::activate", 24);
+           char * const start = s;
+           SV * const sv = newSVpv("use assertions::activate", 24);
            while(isALNUM(*s) || *s == ':') ++s;
            if (s != start) {
                sv_catpvn(sv, "::", 2);
@@ -3096,7 +3099,7 @@ Perl_moreswitches(pTHX_ char *s)
                s+=strlen(s);
            }
            else if (*s != '\0') {
-               Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+               Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
            }
            av_push(PL_preambleav, sv);
            return s;
@@ -3269,7 +3272,7 @@ Perl_moreswitches(pTHX_ char *s)
        PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
        wce_hitreturn();
 #endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
        PerlIO_printf(PerlIO_stdout(),
                      "Symbian port by Nokia, 2004-2005\n");
 #endif
@@ -3607,8 +3610,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 #endif /* IAMSUID */
     if (!PL_rsfp) {
        /* PSz 16 Sep 03  Keep neat error message */
-       Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
-               CopFILE(PL_curcop), Strerror(errno));
+       if (PL_e_script)
+           Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
+       else
+           Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+                   CopFILE(PL_curcop), Strerror(errno));
     }
 }
 
@@ -4592,7 +4598,16 @@ S_init_perllib(pTHX)
     if (!PL_tainting) {
 #ifndef VMS
        s = PerlEnv_getenv("PERL5LIB");
+/*
+ * It isn't possible to delete an environment variable with
+ * PERL_USE_SAFE_PUTENV set unless unsetenv() is also available, so in that
+ * case we treat PERL5LIB as undefined if it has a zero-length value.
+ */
+#if defined(PERL_USE_SAFE_PUTENV) && ! defined(HAS_UNSETENV)
+       if (s && *s != '\0')
+#else
        if (s)
+#endif
            incpush(s, TRUE, TRUE, TRUE, FALSE);
        else
            incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE);
@@ -4700,7 +4715,7 @@ S_init_perllib(pTHX)
 #endif /* MACOS_TRADITIONAL */
 }
 
-#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
+#if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__)
 #    define PERLLIB_SEP ';'
 #else
 #  if defined(VMS)
@@ -5140,7 +5155,7 @@ Perl_my_exit(pTHX_ U32 status)
        STATUS_ALL_FAILURE;
        break;
     default:
-       STATUS_NATIVE_SET(status);
+       STATUS_UNIX_EXIT_SET(status);
        break;
     }
     my_exit_jump();