Merge remote-tracking branch 'origin/stable-2.0'

Conflicts:
	libguile/r6rs-ports.c

4 files changed, 85 insertions, 90 deletions

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index ac778b9de..e3c94e215 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3148,7 +3148,7 @@ placed between the strings, and defaults to the symbol
 @item infix
 Insert the separator between list elements.  An empty string
 will produce an empty list.
-@item string-infix
+@item strict-infix
 Like @code{infix}, but will raise an error if given the empty
 list.
 @item suffix
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 07845c317..7d070514b 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -480,16 +480,11 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
     /* Don't invoke `scm_c_read ()' since it may block.  */
     c_read = 0;
 
-  if ((c_read == 0) && (c_count > 0))
+  if (c_read < c_count)
     {
-      if (scm_peek_byte_or_eof (port) == EOF)
-	result = SCM_EOF_VAL;
+      if (c_read == 0)
+        result = SCM_EOF_VAL;
       else
-	result = scm_null_bytevector;
-    }
-  else
-    {
-      if (c_read < c_count)
 	result = scm_c_shrink_bytevector (result, c_read);
     }
 
@@ -527,13 +522,8 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
     /* Don't invoke `scm_c_read ()' since it may block.  */
     c_read = 0;
 
-  if ((c_read == 0) && (c_count > 0))
-    {
-      if (scm_peek_byte_or_eof (port) == EOF)
-	result = SCM_EOF_VAL;
-      else
-	result = SCM_I_MAKINUM (0);
-    }
+  if (c_read == 0 && c_count > 0)
+    result = SCM_EOF_VAL;
   else
     result = scm_from_size_t (c_read);
 
@@ -583,11 +573,12 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
 	  c_bv[c_total] = (char) c_chr;
 	  c_total++;
 	}
+      else
+        break;
     }
   /* XXX: We want to check for the availability of a byte, but that's
      what `scm_char_ready_p' actually does.  */
-  while (scm_is_true (scm_char_ready_p (port))
-	 && (scm_peek_byte_or_eof_unlocked (port) != EOF));
+  while (scm_is_true (scm_char_ready_p (port)));
 
   if (c_total == 0)
     {
@@ -647,7 +638,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
       c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count);
       c_total += c_read, c_count -= c_read;
     }
-  while (scm_peek_byte_or_eof (port) != EOF);
+  while (c_count == 0);
 
   if (c_total == 0)
     {
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 97c5a1d64..4e5d5725f 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -384,7 +384,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
 	    "@item infix\n"
 	    "Insert the separator between list elements.  An empty string\n"
 	    "will produce an empty list.\n"
-	    "@item string-infix\n"
+	    "@item strict-infix\n"
 	    "Like @code{infix}, but will raise an error if given the empty\n"
 	    "list.\n"
 	    "@item suffix\n"
@@ -394,91 +394,85 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
 	    "@end table")
 #define FUNC_NAME s_scm_string_join
 {
-#define GRAM_INFIX        0
-#define GRAM_STRICT_INFIX 1
-#define GRAM_SUFFIX       2
-#define GRAM_PREFIX       3
-  SCM tmp;
-  SCM result;
-  int gram = GRAM_INFIX;
-  size_t del_len = 0;
-  long strings = scm_ilength (ls);
+  SCM append_list = SCM_EOL;
+  long list_len = scm_ilength (ls);
+  size_t delimiter_len = 0;
 
   /* Validate the string list.  */
-  if (strings < 0)
+  if (list_len < 0)
     SCM_WRONG_TYPE_ARG (1, ls);
 
   /* Validate the delimiter and record its length.  */
   if (SCM_UNBNDP (delimiter))
     {
       delimiter = scm_from_locale_string (" ");
-      del_len = 1;
+      delimiter_len = 1;
     }
   else
     {
       SCM_VALIDATE_STRING (2, delimiter);
-      del_len = scm_i_string_length (delimiter);
+      delimiter_len = scm_i_string_length (delimiter);
     }
 
-  /* Validate the grammar symbol and remember the grammar.  */
+  /* Validate the grammar symbol.  */
   if (SCM_UNBNDP (grammar))
-    gram = GRAM_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_infix))
-    gram = GRAM_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_strict_infix))
-    gram = GRAM_STRICT_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_suffix))
-    gram = GRAM_SUFFIX;
-  else if (scm_is_eq (grammar, scm_sym_prefix))
-    gram = GRAM_PREFIX;
-  else
+    grammar = scm_sym_infix;
+  else if (!(scm_is_eq (grammar, scm_sym_infix)
+             || scm_is_eq (grammar, scm_sym_strict_infix)
+             || scm_is_eq (grammar, scm_sym_suffix)
+             || scm_is_eq (grammar, scm_sym_prefix)))
     SCM_WRONG_TYPE_ARG (3, grammar);
 
-  /* Check grammar constraints.  */
-  if (strings == 0 && gram == GRAM_STRICT_INFIX)
-    SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
-		    SCM_EOL);
+  if (list_len == 0)
+    {
+      if (scm_is_eq (grammar, scm_sym_strict_infix))
+        SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
+                        SCM_EOL);
+      else
+        /* Handle empty lists specially */
+        append_list = SCM_EOL;
+    }
+  else if (delimiter_len == 0)
+    /* Handle empty delimiters specially */
+    append_list = ls;
+  else
+    {
+      SCM *last_cdr_p = &append_list;
 
-  result = scm_i_make_string (0, NULL, 0);
+#define ADD_TO_APPEND_LIST(x)                   \
+      ((*last_cdr_p = scm_list_1 (x)),          \
+       (last_cdr_p = SCM_CDRLOC (*last_cdr_p)))
 
-  tmp = ls;
-  switch (gram)
-    {
-    case GRAM_INFIX:
-    case GRAM_STRICT_INFIX:
-      while (scm_is_pair (tmp))
-	{
-	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-	  if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
-	    result = scm_string_append (scm_list_2 (result, delimiter));
-	  tmp = SCM_CDR (tmp);
-	}
-      break;
-    case GRAM_SUFFIX:
-      while (scm_is_pair (tmp))
-	{
-	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-	  if (del_len > 0)
-	    result = scm_string_append (scm_list_2 (result, delimiter));
-	  tmp = SCM_CDR (tmp);
-	}
-      break;
-    case GRAM_PREFIX:
-      while (scm_is_pair (tmp))
-	{
-	  if (del_len > 0)
-	    result = scm_string_append (scm_list_2 (result, delimiter));
-	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-	  tmp = SCM_CDR (tmp);
-	}
-      break;
+      /* Build a list of strings to pass to 'string-append'.
+         Here we assume that 'ls' has at least one element. */
+
+      /* If using the 'prefix' grammar, start with the delimiter. */
+      if (scm_is_eq (grammar, scm_sym_prefix))
+        ADD_TO_APPEND_LIST (delimiter);
+
+      /* Handle the first element of 'ls' specially, so that in the loop
+         that follows we can unconditionally insert the delimiter before
+         every remaining element. */
+      ADD_TO_APPEND_LIST (SCM_CAR (ls));
+      ls = SCM_CDR (ls);
+
+      /* Insert the delimiter before every remaining element. */
+      while (scm_is_pair (ls))
+        {
+          ADD_TO_APPEND_LIST (delimiter);
+          ADD_TO_APPEND_LIST (SCM_CAR (ls));
+          ls = SCM_CDR (ls);
+        }
+
+      /* If using the 'suffix' grammar, add the delimiter to the end. */
+      if (scm_is_eq (grammar, scm_sym_suffix))
+        ADD_TO_APPEND_LIST (delimiter);
+
+#undef ADD_TO_APPEND_LIST
     }
 
-  return result;
-#undef GRAM_INFIX
-#undef GRAM_STRICT_INFIX
-#undef GRAM_SUFFIX
-#undef GRAM_PREFIX
+  /* Construct the final result. */
+  return scm_string_append (append_list);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 85a6c4839..23a1a7042 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1401,7 +1401,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
 #define FUNC_NAME s_scm_string_append
 {
   SCM res;
-  size_t len = 0;
+  size_t total = 0;
+  size_t len;
   int wide = 0;
   SCM l, s;
   size_t i;
@@ -1416,15 +1417,18 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
     {
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
-      len += scm_i_string_length (s);
+      len = scm_i_string_length (s);
+      if (((size_t) -1) - total < len)
+        scm_num_overflow (s_scm_string_append);
+      total += len;
       if (!scm_i_is_narrow_string (s))
         wide = 1;
     }
   data.narrow = NULL;
   if (!wide)
-    res = scm_i_make_string (len, &data.narrow, 0);
+    res = scm_i_make_string (total, &data.narrow, 0);
   else
-    res = scm_i_make_wide_string (len, &data.wide, 0);
+    res = scm_i_make_wide_string (total, &data.wide, 0);
 
   for (l = args; !scm_is_null (l); l = SCM_CDR (l))
     {
@@ -1432,6 +1436,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
       len = scm_i_string_length (s);
+      if (len > total)
+        SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
       if (!wide)
         {
           memcpy (data.narrow, scm_i_string_chars (s), len);
@@ -1441,16 +1447,20 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
         {
           if (scm_i_is_narrow_string (s))
             {
-              for (i = 0; i < scm_i_string_length (s); i++)
-                data.wide[i] = (unsigned char) scm_i_string_chars (s)[i];
+              const char *src = scm_i_string_chars (s);
+              for (i = 0; i < len; i++)
+                data.wide[i] = (unsigned char) src[i];
             }
           else
             u32_cpy ((scm_t_uint32 *) data.wide,
                      (scm_t_uint32 *) scm_i_string_wide_chars (s), len);
           data.wide += len;
         }
+      total -= len;
       scm_remember_upto_here_1 (s);
     }
+  if (total != 0)
+    SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
   return res;
 }
 #undef FUNC_NAME