From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.bugs Subject: bug#17296: [PATCH] SRFI-1 'length+' raises an error unless passed a proper or circular list Date: Fri, 18 Apr 2014 15:26:48 -0400 Message-ID: <878ur25thj.fsf@yeeloong.lan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1397849370 23977 80.91.229.3 (18 Apr 2014 19:29:30 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 18 Apr 2014 19:29:30 +0000 (UTC) To: 17296@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Fri Apr 18 21:29:23 2014 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1WbETR-0001WA-Sx for guile-bugs@m.gmane.org; Fri, 18 Apr 2014 21:29:22 +0200 Original-Received: from localhost ([::1]:39499 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbETR-0007jQ-Dv for guile-bugs@m.gmane.org; Fri, 18 Apr 2014 15:29:21 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:44079) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbETG-0007iQ-WA for bug-guile@gnu.org; Fri, 18 Apr 2014 15:29:18 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WbET9-00083Q-KI for bug-guile@gnu.org; Fri, 18 Apr 2014 15:29:10 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:44006) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbET9-00083M-Gm for bug-guile@gnu.org; Fri, 18 Apr 2014 15:29:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1WbET8-0001jE-LQ for bug-guile@gnu.org; Fri, 18 Apr 2014 15:29:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Fri, 18 Apr 2014 19:29:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 17296 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-guile@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.13978493296610 (code B ref -1); Fri, 18 Apr 2014 19:29:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 18 Apr 2014 19:28:49 +0000 Original-Received: from localhost ([127.0.0.1]:52163 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WbESt-0001iV-VR for submit@debbugs.gnu.org; Fri, 18 Apr 2014 15:28:48 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:42277) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WbESq-0001iD-9M for submit@debbugs.gnu.org; Fri, 18 Apr 2014 15:28:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WbESd-0007zY-E5 for submit@debbugs.gnu.org; Fri, 18 Apr 2014 15:28:38 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:49210) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbESd-0007zO-BI for submit@debbugs.gnu.org; Fri, 18 Apr 2014 15:28:31 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43888) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbESX-0007gn-1D for bug-guile@gnu.org; Fri, 18 Apr 2014 15:28:31 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WbESQ-0007uq-Oo for bug-guile@gnu.org; Fri, 18 Apr 2014 15:28:24 -0400 Original-Received: from world.peace.net ([96.39.62.75]:57070) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WbESQ-0007uc-K1 for bug-guile@gnu.org; Fri, 18 Apr 2014 15:28:18 -0400 Original-Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong.lan) by world.peace.net with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1WbESI-0003qv-E8; Fri, 18 Apr 2014 15:28:10 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7446 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-SRFI-1-length-raises-an-error-unless-passed-a-proper.patch Content-Description: [PATCH] SRFI-1 'length+' raises an error unless passed a proper or circular list >From 1daa266dd0a6381c58eba950dd935686dadee166 Mon Sep 17 00:00:00 2001 From: Mark H Weaver 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 --=-=-=--