mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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, ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; 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))))) (rest . ,rest)))))
((procedure-source proc) ((procedure-source proc)
=> cadr) => 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)) ((@ (system vm program) program-arguments-alist) proc))
(else #f))) (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)) (and (not (is-case-lambda? flags))
`((required . ,(load-symbols 0 nreq)) `((required . ,(load-symbols 0 nreq))
(optional . ,(load-symbols nreq nopt)) (optional . ,(load-symbols nreq nopt))
(rest . ,(and (has-rest? flags) (load-symbol (+ nreq nopt))))
(keyword . ,(if (has-keyword-args? flags) (keyword . ,(if (has-keyword-args? flags)
(load-non-immediate (load-non-immediate
(+ nreq nopt (if (has-rest? flags) 1 0))) (+ 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) (define (find-first-arity context base addr)
(let* ((bv (elf-bytes (debug-context-elf context))) (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" (pass-if-valid-arguments "lambda* with keywords"
(lambda* (a b #:key (k 42) l) #f) (lambda* (a b #:key (k 42) l) #f)
((required . (a b)) (optional) ((required . (a b)) (optional)
(keyword . ((#:k . 2) (#:l . 3))) (allow-other-keys? . #f) (keyword . ((#:k . 3) (#:l . 4))) (allow-other-keys? . #f)
(rest . #f))) (rest . #f)))
(pass-if-valid-arguments "lambda* with keywords and a-o-k" (pass-if-valid-arguments "lambda* with keywords and a-o-k"
(lambda* (a b #:key (k 42) #:allow-other-keys) #f) (lambda* (a b #:key (k 42) #:allow-other-keys) #f)
((required . (a b)) (optional) ((required . (a b)) (optional)
(keyword . ((#:k . 2))) (allow-other-keys? . #t) (keyword . ((#:k . 3))) (allow-other-keys? . #t)
(rest . #f))) (rest . #f)))
(pass-if-valid-arguments "lambda* with optionals, keys, and rest" (pass-if-valid-arguments "lambda* with optionals, keys, and rest"
(lambda* (a b #:optional o p #:key k l #:rest r) #f) (lambda* (a b #:optional o p #:key k l #:rest r) #f)
((required . (a b)) (optional . (o p)) ((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))) (rest . r)))
(pass-if "aok? is preserved" (pass-if "aok? is preserved"