mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Fix procedure-arguments on RTL programs, and tweak session.test

Browse source 
* module/ice-9/session.scm (procedure-arguments): Add an rtl-program?
  case.

* module/system/vm/debug.scm (arity-arguments-alist): Use the order that
  session.test expects.

* test-suite/tests/session.test ("procedure-arguments"): Adapt tests
  with keywords for the new starting-with-the-procedure numbering of
  locals.
This commit is contained in:
Andy Wingo 2013-11-08 13:29:03 +01:00
parent d547e1c9a6
commit f41accb9c2
3 changed files with 8 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/ice-9/session.scm
View file

@ -1,5 +1,5 @@
;;;; Copyright (C) 1997, 2000, 2001, 2003, 2006, 2009, 2010, 2011,
;;;; 2012 Free Software Foundation, Inc.
;;;; 2012, 2013 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
@ -522,7 +522,8 @@ The alist keys that are currently defined are `required', `optional',
(rest . ,rest)))))
((procedure-source proc)
=> cadr)
(((@ (system vm program) program?) proc)
((or ((@ (system vm program) program?) proc)
((@ (system vm program) rtl-program?) proc))
((@ (system vm program) program-arguments-alist) proc))
(else #f)))

4
module/system/vm/debug.scm
View file

@ -340,12 +340,12 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
(and (not (is-case-lambda? flags))
`((required . ,(load-symbols 0 nreq))
(optional . ,(load-symbols nreq nopt))
(rest . ,(and (has-rest? flags) (load-symbol (+ nreq nopt))))
(keyword . ,(if (has-keyword-args? flags)
(load-non-immediate
(+ nreq nopt (if (has-rest? flags) 1 0)))
'()))
(allow-other-keys? . ,(allow-other-keys? flags))))))
(allow-other-keys? . ,(allow-other-keys? flags))
(rest . ,(and (has-rest? flags) (load-symbol (+ nreq nopt))))))))
(define (find-first-arity context base addr)
(let* ((bv (elf-bytes (debug-context-elf context)))

6
test-suite/tests/session.test
View file

@ -77,17 +77,17 @@
(pass-if-valid-arguments "lambda* with keywords"
(lambda* (a b #:key (k 42) l) #f)
((required . (a b)) (optional)
(keyword . ((#:k . 2) (#:l . 3))) (allow-other-keys? . #f)
(keyword . ((#:k . 3) (#:l . 4))) (allow-other-keys? . #f)
(rest . #f)))
(pass-if-valid-arguments "lambda* with keywords and a-o-k"
(lambda* (a b #:key (k 42) #:allow-other-keys) #f)
((required . (a b)) (optional)
(keyword . ((#:k . 2))) (allow-other-keys? . #t)
(keyword . ((#:k . 3))) (allow-other-keys? . #t)
(rest . #f)))
(pass-if-valid-arguments "lambda* with optionals, keys, and rest"
(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)
(keyword . ((#:k . 6) (#:l . 7))) (allow-other-keys? . #f)
(rest . r)))
(pass-if "aok? is preserved"