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

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

diff --git a/sv.c b/sv.c
index 08d9b6a..df5a556 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3309,8 +3309,9 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
                        }
                    }
                if (!intro)
-                   cv_ckproto(cv, (GV*)dstr,
-                              SvPOK(sref) ? SvPVX_const(sref) : NULL);
+                   cv_ckproto_len(cv, (GV*)dstr,
+                                  SvPOK(sref) ? SvPVX_const(sref) : NULL,
+                                  SvPOK(sref) ? SvCUR(sref) : 0);
            }
            GvCVGEN(dstr) = 0; /* Switch off cacheness. */
            GvASSUMECV_on(dstr);
@@ -3885,23 +3886,27 @@ Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr)
 }
 
 /*
-=for apidoc sv_usepvn
+=for apidoc sv_usepvn_flags
 
 Tells an SV to use C<ptr> to find its string value.  Normally the
 string is stored inside the SV but sv_usepvn allows the SV to use an
 outside string.  The C<ptr> should point to memory that was allocated
-by C<malloc>.  The string length, C<len>, must be supplied.  This
-function will realloc (i.e. move) the memory pointed to by C<ptr>,
+by C<malloc>.  The string length, C<len>, must be supplied.  By default
+this function will realloc (i.e. move) the memory pointed to by C<ptr>,
 so that pointer should not be freed or used by the programmer after
 giving it to sv_usepvn, and neither should any pointers from "behind"
-that pointer (e.g. ptr + 1) be used.  Does not handle 'set' magic.
-See C<sv_usepvn_mg>.
+that pointer (e.g. ptr + 1) be used.
+
+If C<flags> & SV_SMAGIC is true, will call SvSETMAGIC. If C<flags> &
+SV_HAS_TRAILING_NUL is true, then C<ptr[len]> must be NUL, and the realloc
+will be skipped. (i.e. the buffer is actually at least 1 byte longer than
+C<len>, and already meets the requirements for storing in C<SvPVX>)
 
 =cut
 */
 
 void
-Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
+Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
 {
     dVAR;
     STRLEN allocate;
@@ -3909,34 +3914,43 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
     SvUPGRADE(sv, SVt_PV);
     if (!ptr) {
        (void)SvOK_off(sv);
+       if (flags & SV_SMAGIC)
+           SvSETMAGIC(sv);
        return;
     }
     if (SvPVX_const(sv))
        SvPV_free(sv);
 
-    allocate = PERL_STRLEN_ROUNDUP(len + 1);
-    ptr = saferealloc (ptr, allocate);
+    if (flags & SV_HAS_TRAILING_NUL)
+       assert(ptr[len] == '\0');
+
+    allocate = (flags & SV_HAS_TRAILING_NUL)
+       ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
+    if (flags & SV_HAS_TRAILING_NUL) {
+       /* It's long enough - do nothing.
+          Specfically Perl_newCONSTSUB is relying on this.  */
+    } else {
+#ifdef DEBUGGING
+       /* Force a move to shake out bugs in callers.  */
+       char *new_ptr = safemalloc(allocate);
+       Copy(ptr, new_ptr, len, char);
+       PoisonFree(ptr,len,char);
+       Safefree(ptr);
+       ptr = new_ptr;
+#else
+       ptr = saferealloc (ptr, allocate);
+#endif
+    }
     SvPV_set(sv, ptr);
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
-    *SvEND(sv) = '\0';
+    if (!(flags & SV_HAS_TRAILING_NUL)) {
+       *SvEND(sv) = '\0';
+    }
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
-}
-
-/*
-=for apidoc sv_usepvn_mg
-
-Like C<sv_usepvn>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
-{
-    sv_usepvn(sv,ptr,len);
-    SvSETMAGIC(sv);
+    if (flags & SV_SMAGIC)
+       SvSETMAGIC(sv);
 }
 
 #ifdef PERL_OLD_COPY_ON_WRITE