merge from 1.8

doc/ref/api-procedures.texi

@@ -198,30 +198,72 @@ evaluated in order.
 @node let-keywords Reference
 @subsubsection let-keywords Reference
 
-@c FIXME::martin: Review me!
+@code{let-keywords} and @code{let-keywords*} extract values from
+keyword style argument lists, binding local variables to those values
+or to defaults.
 
-@code{let-keywords} and @code{let-keywords*} are used for extracting
+@deffn {library syntax} let-keywords args allow-other-keys? (binding @dots{})  body @dots{}
-values from argument lists which use keywords instead of argument
+@deffnx {library syntax} let-keywords* args allow-other-keys? (binding @dots{})  body @dots{}
-position for binding local variables to argument values.
+@var{args} is evaluated and should give a list of the form
+@code{(#:keyword1 value1 #:keyword2 value2 @dots{})}.  The
+@var{binding}s are variables and default expressions, with the
+variables to be set (by name) from the keyword values.  The @var{body}
+forms are then evaluated and the last is the result.  An example will
+make the syntax clearest,
 
-@code{let-keywords} binds all variables simultaneously, while
+@example
-@code{let-keywords*} binds them sequentially, consistent with @code{let}
+(define args '(#:xyzzy "hello" #:foo "world"))
-and @code{let*} (@pxref{Local Bindings}).
 
-@deffn {library syntax} let-keywords rest-arg allow-other-keys? (binding @dots{})  expr @dots{}
+(let-keywords args #t
-@deffnx {library syntax} let-keywords* rest-arg allow-other-keys? (binding @dots{})  expr @dots{}
+      ((foo  "default for foo")
-These macros pick out keyword arguments from @var{rest-arg}, but do not
+       (bar  (string-append "default" "for" "bar")))
-modify it.  This is consistent at least with Common Lisp, which
+  (display foo)
-duplicates keyword arguments in the rest argument. More explanation of what
+  (display ", ")
-keyword arguments in a lambda list look like can be found below in
+  (display bar))
-the documentation for @code{lambda*}
+@print{} world, defaultforbar
- (@pxref{lambda* Reference}).  @var{binding}s can have the same form as
+@end example
-for @code{let-optional}. If @var{allow-other-keys?} is false, an error
-will be thrown if anything that looks like a keyword argument but does
-not match a known keyword parameter will result in an error.
 
-After binding the variables, the expressions @var{expr} @dots{} are
+The binding for @code{foo} comes from the @code{#:foo} keyword in
-evaluated in order.
+@code{args}.  But the binding for @code{bar} is the default in the
+@code{let-keywords}, since there's no @code{#:bar} in the args.
+
+@var{allow-other-keys?} is evaluated and controls whether unknown
+keywords are allowed in the @var{args} list.  When true other keys are
+ignored (such as @code{#:xyzzy} in the example), when @code{#f} an
+error is thrown for anything unknown.
+
+@code{let-keywords} is like @code{let} (@pxref{Local Bindings}) in
+that all bindings are made at once, the defaults expressions are
+evaluated (if needed) outside the scope of the @code{let-keywords}.
+
+@code{let-keywords*} is like @code{let*}, each binding is made
+successively, and the default expressions see the bindings previously
+made.  This is the style used by @code{lambda*} keywords
+(@pxref{lambda* Reference}).  For example,
+
+@example
+(define args '(#:foo 3))
+
+(let-keywords* args #f
+      ((foo  99)
+       (bar  (+ foo 6)))
+  (display bar))
+@print{} 9
+@end example
+
+The expression for each default is only evaluated if it's needed,
+ie. if the keyword doesn't appear in @var{args}.  So one way to make a
+keyword mandatory is to throw an error of some sort as the default.
+
+@example
+(define args '(#:start 7 #:finish 13))
+
+(let-keywords* args #t
+      ((start 0)
+       (stop  (error "missing #:stop argument")))
+  ...)
+@result{} ERROR: missing #:stop argument
+@end example
 @end deffn
 
 

libguile/ChangeLog

@@ -1,4 +1,3 @@
-<<<<<<< ChangeLog
 2007-01-16  Kevin Ryde  <user42@zip.com.au>
 
 	* feature.c, feature.h (scm_set_program_arguments_scm): New function,

test-suite/standalone/test-use-srfi

@@ -0,0 +1,67 @@
+#!/bin/sh
+
+# Copyright (C) 2006 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 as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at
+# your option) any later version.
+#
+# This library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with this library; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+# Test that two srfi numbers on the command line work.
+#
+guile --use-srfi=1,10 >/dev/null <<EOF
+(if (and (defined? 'partition)
+         (defined? 'define-reader-ctor))
+    (exit 0)   ;; good
+    (exit 1))  ;; bad
+EOF
+if test $? = 0; then :; else
+  echo "guile --user-srfi=1,10 fails to run"
+  exit 1
+fi
+
+
+# Test that running "guile --use-srfi=1" leaves the interactive REPL with
+# the srfi-1 version of iota.
+#
+# In guile 1.8.1 and earlier, and 1.6.8 and earlier, these failed because in
+# `top-repl' the core bindings got ahead of anything --use-srfi gave.
+#
+
+guile --use-srfi=1 >/dev/null <<EOF
+(catch #t
+  (lambda ()
+    (iota 2 3 4))
+  (lambda args
+    (exit 1))) ;; bad
+(exit 0)       ;; good
+EOF
+if test $? = 0; then :; else
+  echo "guile --user-srfi=1 doesn't give SRFI-1 iota"
+  exit 1
+fi
+
+
+# Similar test on srfi-17 car, which differs in being a #:replacement.  This
+# exercises duplicates handling in `top-repl' versus `use-srfis' (in
+# boot-9.scm).
+#
+guile --use-srfi=17 >/dev/null <<EOF
+(if (procedure-with-setter? car)
+    (exit 0)   ;; good
+    (exit 1))  ;; bad
+EOF
+if test $? = 0; then :; else
+  echo "guile --user-srfi=17 doesn't give SRFI-17 car"
+  exit 1
+fi

test-suite/tests/regexp.test

@@ -1,7 +1,7 @@
 ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 ;;;;
-;;;; 	Copyright (C) 1999, 2004, 2006 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1999, 2004, 2006, 2007 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -70,6 +70,38 @@
   (pass-if "foo offset 1"
     (string=? "foo" (match:string (string-match ".*" "foo" 1)))))
 
+;;;
+;;; regexp-exec
+;;;
+
+(with-test-prefix "regexp-exec"
+
+  (pass-if-exception "non-integer offset" exception:wrong-type-arg
+    (let ((re (make-regexp "ab+")))
+      (regexp-exec re "aaaabbbb" 1.5 'bogus-flags-arg)))
+
+  (pass-if-exception "non-string input" exception:wrong-type-arg
+    (let ((re (make-regexp "ab+")))
+      (regexp-exec re 'not-a-string)))
+
+  (pass-if-exception "non-string input, with offset" exception:wrong-type-arg
+    (let ((re (make-regexp "ab+")))
+      (regexp-exec re 'not-a-string 5)))
+
+  ;; in guile 1.8.1 and earlier, a #\nul character in the input string was
+  ;; only detected in a critical section, and the resulting error throw
+  ;; abort()ed the program
+  (pass-if-exception "nul in input" exception:string-contains-nul
+    (let ((re (make-regexp "ab+")))
+      (regexp-exec re (string #\a #\b (integer->char 0)))))
+
+  ;; in guile 1.8.1 and earlier, a bogus flags argument was only detected
+  ;; inside a critical section, and the resulting error throw abort()ed the
+  ;; program
+  (pass-if-exception "non-integer flags" exception:wrong-type-arg
+    (let ((re (make-regexp "ab+")))
+      (regexp-exec re "aaaabbbb" 0 'bogus-flags-arg))))      
+
 ;;;
 ;;; regexp-quote
 ;;;

test-suite/tests/srfi-17.test

@@ -32,6 +32,13 @@
 
 (with-test-prefix "car"
 
+  ;; this test failed in guile 1.8.1 and 1.6.8 and earlier, since `define'
+  ;; didn't set a name on a procedure-with-setter
+  (pass-if "procedure-name"
+    (if (memq 'procnames (debug-options)) ;; enabled by default
+	(eq? 'car (procedure-name car))
+	(throw 'unsupported)))
+
   (pass-if "set! (car x)"
     (let ((lst (list 1)))
       (set! (car lst) 2)