--- Begin Message ---
|
Subject: |
[PATCH] SRFI-1 'length+' raises an error unless passed a proper or circular list |
|
Date: |
Fri, 18 Apr 2014 15:26:48 -0400 |
According to the SRFI-1 spec, 'length+' must be passed a proper or
circular list. It should raise an error when passed a non-pair or an
improper list, but instead it returns #f in such cases:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (use-modules (srfi srfi-1))
scheme@(guile-user)> (length+ 5)
$1 = #f
scheme@(guile-user)> (length+ 'x)
$2 = #f
scheme@(guile-user)> (length+ '(x . y))
$3 = #f
--8<---------------cut here---------------end--------------->8---
One side effect of this is that SRFI-1 'map', which uses 'length+' to
validate the arguments and find the shortest length, accepts improper
lists and non-pairs as arguments as long as one of the arguments is a
proper list:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (map + '(1 2) '(1 2 3 . 4))
$4 = (2 4)
scheme@(guile-user)> (map + '() 2)
$5 = ()
scheme@(guile-user)> (map + '(1) 2)
ERROR: In procedure cdr:
ERROR: In procedure cdr: Wrong type (expecting pair): 2
--8<---------------cut here---------------end--------------->8---
The attached patch fixes these problems.
Mark
>From 1daa266dd0a6381c58eba950dd935686dadee166 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Fri, 18 Apr 2014 15:04:12 -0400
Subject: [PATCH] SRFI-1 'length+' raises an error unless passed a proper or
circular list.
* 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.
---
libguile/srfi-1.c | 30 +++++++++++++++++++++++++++---
test-suite/tests/srfi-1.test | 7 ++++++-
2 files changed, 33 insertions(+), 4 deletions(-)
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 54c7e2a..a7ffeec 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.
+ * 2008, 2009, 2010, 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
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index d40f8e1..9a2ed94 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1,6 +1,7 @@
;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2004, 2005, 2006, 2008, 2009, 2010, 2011 Free Software
Foundation, Inc.
+;;;; Copyright 2003, 2004, 2005, 2006, 2008, 2009, 2010, 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
@@ -1329,6 +1330,10 @@
(length+))
(pass-if-exception "too many args" exception:wrong-num-args
(length+ 123 456))
+ (pass-if-exception "not a pair" exception:wrong-type-arg
+ (length+ 'x))
+ (pass-if-exception "improper list" exception:wrong-type-arg
+ (length+ '(x y . z)))
(pass-if (= 0 (length+ '())))
(pass-if (= 1 (length+ '(x))))
(pass-if (= 2 (length+ '(x y))))
--
1.8.4
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: bug#17296: [PATCH] SRFI-1 'length+' raises an error unless passed a proper or circular list |
|
Date: |
Sun, 01 Jun 2014 20:56:21 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) |
Mark H Weaver <address@hidden> writes:
> According to the SRFI-1 spec, 'length+' must be passed a proper or
> circular list. It should raise an error when passed a non-pair or an
> improper list, but instead it returns #f in such cases:
>
> scheme@(guile-user)> (use-modules (srfi srfi-1))
> scheme@(guile-user)> (length+ 5)
> $1 = #f
> scheme@(guile-user)> (length+ 'x)
> $2 = #f
> scheme@(guile-user)> (length+ '(x . y))
> $3 = #f
>
> One side effect of this is that SRFI-1 'map', which uses 'length+' to
> validate the arguments and find the shortest length, accepts improper
> lists and non-pairs as arguments as long as one of the arguments is a
> proper list:
>
> scheme@(guile-user)> (map + '(1 2) '(1 2 3 . 4))
> $4 = (2 4)
> scheme@(guile-user)> (map + '() 2)
> $5 = ()
> scheme@(guile-user)> (map + '(1) 2)
> ERROR: In procedure cdr:
> ERROR: In procedure cdr: Wrong type (expecting pair): 2
>
> The attached patch fixes these problems.
Pushed to stable-2.0, commit a5186f506f69ef8a8accd234ca434efd13f302c9.
I'm closing this bug.
Mark
--- End Message ---