[Guile-commits] GNU Guile branch, master, updated. v2.1.0-351-g1e05106

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1e051065628a7f1bd4398fcc11cd181f86084629

The branch, master has been updated
       via  1e051065628a7f1bd4398fcc11cd181f86084629 (commit)
       via  de2bc673bba931a70e3b96336cab6512a47541fe (commit)
       via  786ab4258fbf605f46287da5e7550d3ab4b68589 (commit)
       via  2f13a46672a347be0f7bb1b360a213f6d6ce0288 (commit)
       via  3b80c3585221a899c9a6b87e742d267655bb0abc (commit)
       via  47f2bce5ae332c274270882c259776b8e4ea12f7 (commit)
      from  86cf4773ff94a128247d484e6d69786869f41ebc (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1e051065628a7f1bd4398fcc11cd181f86084629
Merge: 86cf477 de2bc67
Author: Mark H Weaver <address@hidden>
Date:   Mon Apr 1 05:42:31 2013 -0400

    Merge remote-tracking branch 'origin/stable-2.0'
    
    Conflicts:
        libguile/r6rs-ports.c

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-data.texi |    2 +-
 libguile/r6rs-ports.c |   27 ++++-------
 libguile/srfi-13.c    |  124 +++++++++++++++++++++++-------------------------
 libguile/strings.c    |   22 ++++++--
 4 files changed, 85 insertions(+), 90 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index ac778b9..e3c94e2 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.
address@hidden string-infix
address@hidden 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 07845c3..7d07051 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 97c5a1d..4e5d572 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 85a6c48..23a1a70 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


hooks/post-receive
-- 
GNU Guile