Changes to perlfaq8 "How do I find out if I'm running interactively

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

diff --git a/util.c b/util.c
index 4022bb0..285b8b8 100644 (file)
--- a/util.c
+++ b/util.c
@@ -99,7 +99,7 @@ Perl_safesysmalloc(MEM_SIZE size)
 #endif
 
 #ifdef PERL_POISON
-       Poison(((char *)ptr), size, char);
+       PoisonNew(((char *)ptr), size, char);
 #endif
 
 #ifdef PERL_TRACK_MEMPOOL
@@ -165,7 +165,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
        if (header->size > size) {
            const MEM_SIZE freed_up = header->size - size;
            char *start_of_freed = ((char *)where) + size;
-           Poison(start_of_freed, freed_up, char);
+           PoisonFree(start_of_freed, freed_up, char);
        }
        header->size = size;
 #  endif
@@ -190,7 +190,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
        if (header->size < size) {
            const MEM_SIZE fresh = size - header->size;
            char *start_of_fresh = ((char *)ptr) + size;
-           Poison(start_of_fresh, fresh, char);
+           PoisonNew(start_of_fresh, fresh, char);
        }
 #  endif
 
@@ -241,7 +241,7 @@ Perl_safesysfree(Malloc_t where)
            header->next->prev = header->prev;
            header->prev->next = header->next;
 #  ifdef PERL_POISON
-           Poison(where, header->size, char);
+           PoisonNew(where, header->size, char);
 #  endif
            /* Trigger the duplicate free warning.  */
            header->next = NULL;
@@ -895,8 +895,8 @@ Perl_savepv(pTHX_ const char *pv)
 
 Perl's version of what C<strndup()> would be if it existed. Returns a
 pointer to a newly allocated string which is a duplicate of the first
-C<len> bytes from C<pv>. The memory allocated for the new string can be
-freed with the C<Safefree()> function.
+C<len> bytes from C<pv>, plus a trailing NUL byte. The memory allocated for
+the new string can be freed with the C<Safefree()> function.
 
 =cut
 */
@@ -1531,7 +1531,18 @@ Perl_ckwarn_d(pTHX_ U32 w)
        ;
 }
 
+/* Set buffer=NULL to get a new one.  */
+STRLEN *
+Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
+                          STRLEN size) {
+    const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
 
+    buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
+       : PerlMemShared_realloc(buffer, len_wanted);
+    buffer[0] = size;
+    Copy(bits, (buffer + 1), size, char);
+    return buffer;
+}
 
 /* since we've already done strlen() for both nam and val
  * we can use that info to make things faster than
@@ -1590,15 +1601,15 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
     }
     else
        safesysfree(environ[i]);
-    nlen = strlen(nam);
-    vlen = strlen(val);
+       nlen = strlen(nam);
+       vlen = strlen(val);
 
-    environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
-    /* all that work just for this */
-    my_setenv_format(environ[i], nam, nlen, val, vlen);
+       environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+       /* all that work just for this */
+       my_setenv_format(environ[i], nam, nlen, val, vlen);
     } else {
 # endif
-#   if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__)
+#   if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__) || defined(__riscos__)
 #       if defined(HAS_UNSETENV)
         if (val == NULL) {
             (void)unsetenv(nam);
@@ -3419,6 +3430,7 @@ Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
     const char * const func =
        op == OP_READLINE   ? "readline"  :     /* "<HANDLE>" not nice */
        op == OP_LEAVEWRITE ? "write" :         /* "write exit" not nice */
+       op < 0              ? "" :              /* handle phoney cases */
        PL_op_desc[op];
     const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
     const char * const type = OP_IS_SOCKET(op)
@@ -4912,6 +4924,8 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
                      opt |= PERL_UNICODE_LOCALE_FLAG;  break;
                 case PERL_UNICODE_ARGV:
                      opt |= PERL_UNICODE_ARGV_FLAG;    break;
+                case PERL_UNICODE_UTF8CACHEASSERT:
+                     opt |= PERL_UNICODE_UTF8CACHEASSERT_FLAG; break;
                 default:
                      if (*p != '\n' && *p != '\r')
                          Perl_croak(aTHX_