1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

Have procedure-arguments' always return the allow-other-keys?' pair.

Fixes <http://bugs.gnu.org/10938>.
Based on a patch by Stefan Israelsson Tampe <stefan.itampe@gmail.com>.

* module/ice-9/session.scm (procedure-arguments): When the 'arglist
  property is available, emit the `allow-other-keys?' pair.  Use
  `match-lambda'.

* test-suite/tests/session.test ("procedure-arguments")["aok? is
  preserved"]: New test.
This commit is contained in:
Ludovic Courtès 2012-07-01 17:32:03 +02:00
parent bfdbea1f20
commit a8215aedad
2 changed files with 19 additions and 8 deletions

View file

@ -1,4 +1,5 @@
;;;; Copyright (C) 1997, 2000, 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; Copyright (C) 1997, 2000, 2001, 2003, 2006, 2009, 2010, 2011,
;;;; 2012 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
@ -20,6 +21,7 @@
#:use-module (ice-9 documentation)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:export (help
add-value-help-handler! remove-value-help-handler!
add-name-help-handler! remove-name-help-handler!
@ -504,14 +506,16 @@ It is an image under the mapping EXTRACT."
if the information cannot be obtained.
The alist keys that are currently defined are `required', `optional',
`keyword', and `rest'."
`keyword', `allow-other-keys?', and `rest'."
(cond
((procedure-property proc 'arglist)
=> (lambda (arglist)
`((required . ,(car arglist))
(optional . ,(cadr arglist))
(keyword . ,(caddr arglist))
(rest . ,(car (cddddr arglist))))))
=> (match-lambda
((req opt keyword aok? rest)
`((required . ,req)
(optional . ,opt)
(keyword . ,keyword)
(allow-other-keys? . ,aok?)
(rest . ,rest)))))
((procedure-source proc)
=> cadr)
(((@ (system vm program) program?) proc)

View file

@ -87,7 +87,14 @@
(lambda* (a b #:optional o p #:key k l #:rest r) #f)
((required . (a b)) (optional . (o p))
(keyword . ((#:k . 5) (#:l . 6))) (allow-other-keys? . #f)
(rest . k))))
(rest . k)))
(pass-if "aok? is preserved"
;; See <http://bugs.gnu.org/10938>.
(let* ((proc (compile '(lambda (a b) #f) #:to 'value))
(args (procedure-arguments proc)))
(set-procedure-property! proc 'arglist (map cdr args))
(equal? args (procedure-arguments proc)))))
;;; Local Variables:
;;; eval: (put 'pass-if-valid-arguments 'scheme-indent-function 1)