summaryrefslogtreecommitdiff
path: root/libguile/srfi-1.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2014-04-18 15:04:12 -0400
committerMark H Weaver <mhw@netris.org>2014-06-01 19:19:40 -0400
commita5186f506f69ef8a8accd234ca434efd13f302c9 (patch)
tree7ebaceaf19c1e738ebf3b504c7af4b5567010872 /libguile/srfi-1.c
parent12c6a47773041ff5d0a3553421d2f358d9e479a9 (diff)
downloadguile-a5186f506f69ef8a8accd234ca434efd13f302c9.tar.gz
SRFI-1 'length+' raises an error unless passed a proper or circular list.
Fixes <http://bugs.gnu.org/17296>. * libguile/srfi-1.c (scm_srfi1_length_plus): Rewrite to raise an error unless passed a proper or circular list, based on code from 'scm_ilength'. * test-suite/tests/srfi-1.test (length+): Add tests.
Diffstat (limited to 'libguile/srfi-1.c')
-rw-r--r--libguile/srfi-1.c32
1 files changed, 28 insertions, 4 deletions
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 54c7e2aa3..fcbf80694 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -1,7 +1,7 @@
/* srfi-1.c --- SRFI-1 procedures for Guile
*
- * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006,
- * 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ * Copyright (C) 1995-1997, 2000-2003, 2005, 2006, 2008-2011,
+ * 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -614,8 +614,32 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
"circular.")
#define FUNC_NAME s_scm_srfi1_length_plus
{
- long len = scm_ilength (lst);
- return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
+ size_t i = 0;
+ SCM tortoise = lst;
+ SCM hare = lst;
+
+ do
+ {
+ if (SCM_NULL_OR_NIL_P (hare))
+ return scm_from_size_t (i);
+ if (!scm_is_pair (hare))
+ scm_wrong_type_arg_msg (FUNC_NAME, 1, lst, "proper or circular list");
+ hare = SCM_CDR (hare);
+ i++;
+ if (SCM_NULL_OR_NIL_P (hare))
+ return scm_from_size_t (i);
+ if (!scm_is_pair (hare))
+ scm_wrong_type_arg_msg (FUNC_NAME, 1, lst, "proper or circular list");
+ hare = SCM_CDR (hare);
+ i++;
+ /* For every two steps the hare takes, the tortoise takes one. */
+ tortoise = SCM_CDR(tortoise);
+ }
+ while (!scm_is_eq (hare, tortoise));
+
+ /* If the tortoise ever catches the hare, then the list must contain
+ a cycle. */
+ return SCM_BOOL_F;
}
#undef FUNC_NAME