summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-11-08 13:29:03 +0100
committerAndy Wingo <wingo@pobox.com>2013-11-08 13:29:03 +0100
commitf41accb9c26e3b4df4170bda04b8860ee962657f (patch)
treed97ec5b5d0ae7fd616b5cf301c5046d06dccd609
parentd547e1c9a647c8218bdf64b00e8c11af1f7d5a0a (diff)
downloadguile-f41accb9c26e3b4df4170bda04b8860ee962657f.tar.gz
Fix procedure-arguments on RTL programs, and tweak session.test
* 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.
-rw-r--r--module/ice-9/session.scm5
-rw-r--r--module/system/vm/debug.scm4
-rw-r--r--test-suite/tests/session.test6
3 files changed, 8 insertions, 7 deletions
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index ce1bcac7c..ff1114727 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -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)))
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 561143263..09bc16113 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -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)))
diff --git a/test-suite/tests/session.test b/test-suite/tests/session.test
index c9aa4a06c..f6fd38951 100644
--- a/test-suite/tests/session.test
+++ b/test-suite/tests/session.test
@@ -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"