This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PL_inf/PL_nan need different export with C++
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 9ad40c1..a69ddad 100644 (file)
--- a/util.c
+++ b/util.c
@@ -522,17 +522,26 @@ Free_t   Perl_mfree (Malloc_t where)
 
 #endif
 
-/* copy a string up to some (non-backslashed) delimiter, if any */
+/* copy a string up to some (non-backslashed) delimiter, if any.
+ * With allow_escape, converts \<delimiter> to <delimiter>, while leaves
+ * \<non-delimiter> as-is.
+ * Returns the position in the src string of the closing delimiter, if
+ * any, or returns fromend otherwise.
+ * This is the internal implementation for Perl_delimcpy and
+ * Perl_delimcpy_no_escape.
+ */
 
-char *
-Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend, int delim, I32 *retlen)
+static char *
+S_delimcpy_intern(char *to, const char *toend, const char *from,
+          const char *fromend, int delim, I32 *retlen,
+          const bool allow_escape)
 {
     I32 tolen;
 
     PERL_ARGS_ASSERT_DELIMCPY;
 
     for (tolen = 0; from < fromend; from++, tolen++) {
-       if (*from == '\\') {
+       if (allow_escape && *from == '\\' && from + 1 < fromend) {
            if (from[1] != delim) {
                if (to < toend)
                    *to++ = *from;
@@ -551,16 +560,21 @@ Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend
     return (char *)from;
 }
 
-/* return ptr to little string in big string, NULL if not found */
-/* This routine was donated by Corey Satten. */
-
 char *
-Perl_instr(const char *big, const char *little)
+Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend, int delim, I32 *retlen)
 {
+    PERL_ARGS_ASSERT_DELIMCPY;
 
-    PERL_ARGS_ASSERT_INSTR;
+    return S_delimcpy_intern(to, toend, from, fromend, delim, retlen, 1);
+}
 
-    return strstr((char*)big, (char*)little);
+char *
+Perl_delimcpy_no_escape(char *to, const char *toend, const char *from,
+                       const char *fromend, int delim, I32 *retlen)
+{
+    PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE;
+
+    return S_delimcpy_intern(to, toend, from, fromend, delim, retlen, 0);
 }
 
 /*
@@ -596,6 +610,11 @@ char *
 Perl_ninstr(const char *big, const char *bigend, const char *little, const char *lend)
 {
     PERL_ARGS_ASSERT_NINSTR;
+
+#ifdef HAS_MEMMEM
+    return ninstr(big, bigend, little, lend);
+#else
+
     if (little >= lend)
         return (char*)big;
     {
@@ -614,6 +633,9 @@ Perl_ninstr(const char *big, const char *bigend, const char *little, const char
         }
     }
     return NULL;
+
+#endif
+
 }
 
 /*
@@ -5018,6 +5040,8 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name,
                   const char *filename, const int linenumber,
                   const char *funcname)
 {
+    PERL_ARGS_ASSERT_MEM_LOG_ALLOC;
+
     mem_log_common_if(MLT_ALLOC, n, typesize, type_name,
                      NULL, NULL, newalloc,
                      filename, linenumber, funcname);
@@ -5030,6 +5054,8 @@ Perl_mem_log_realloc(const UV n, const UV typesize, const char *type_name,
                     const char *filename, const int linenumber, 
                     const char *funcname)
 {
+    PERL_ARGS_ASSERT_MEM_LOG_REALLOC;
+
     mem_log_common_if(MLT_REALLOC, n, typesize, type_name,
                      NULL, oldalloc, newalloc, 
                      filename, linenumber, funcname);
@@ -5041,6 +5067,8 @@ Perl_mem_log_free(Malloc_t oldalloc,
                  const char *filename, const int linenumber, 
                  const char *funcname)
 {
+    PERL_ARGS_ASSERT_MEM_LOG_FREE;
+
     mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, 
                      filename, linenumber, funcname);
     return oldalloc;
@@ -5294,7 +5322,8 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     PERL_UNUSED_ARG(buffer);
     PERL_UNUSED_ARG(len);
     PERL_UNUSED_ARG(format);
-    PERL_UNUSED_ARG(ap);
+    /* the cast is to avoid gcc -Wsizeof-array-argument complaining */
+    PERL_UNUSED_ARG((void*)ap);
     Perl_croak_nocontext("panic: my_vsnprintf not available with quadmath");
     return 0;
 #else
@@ -5701,9 +5730,13 @@ Note that C<size> is the full size of the destination buffer and
 the result is guaranteed to be C<NUL>-terminated if there is room.  Note that
 room for the C<NUL> should be included in C<size>.
 
+The return value is the total length that C<dst> would have if C<size> is
+sufficiently large.  Thus it is the initial length of C<dst> plus the length of
+C<src>.  If C<size> is smaller than the return, the excess was not appended.
+
 =cut
 
-Description stolen from http://www.openbsd.org/cgi-bin/man.cgi?query=strlcat
+Description stolen from http://man.openbsd.org/strlcat.3
 */
 #ifndef HAS_STRLCAT
 Size_t
@@ -5732,9 +5765,12 @@ This operates on C C<NUL>-terminated strings.
 C<my_strlcpy()> copies up to S<C<size - 1>> characters from the string C<src>
 to C<dst>, C<NUL>-terminating the result if C<size> is not 0.
 
+The return value is the total length C<src> would be if the copy completely
+succeeded.  If it is larger than C<size>, the excess was not copied.
+
 =cut
 
-Description stolen from http://www.openbsd.org/cgi-bin/man.cgi?query=strlcpy
+Description stolen from http://man.openbsd.org/strlcpy.3
 */
 #ifndef HAS_STRLCPY
 Size_t