summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-11-15 23:38:40 +0100
committerAndy Wingo <wingo@pobox.com>2011-11-15 23:41:51 +0100
commitee15aa46e3fb29e609bd7c431e8f2676f6573d57 (patch)
tree57374d33ec538ece9ca8cb6227ecb17463538c81
parentf3cf9421cb319e2cb9ffde4ec41cad7fdcafcebc (diff)
downloadguile-ee15aa46e3fb29e609bd7c431e8f2676f6573d57.tar.gz
set names of functions defined at the toplevel from `eval'
* module/ice-9/eval.scm (primitive-eval): Set the name of toplevel-defined functions.
-rw-r--r--module/ice-9/eval.scm5
-rw-r--r--test-suite/tests/procprop.test7
2 files changed, 10 insertions, 2 deletions
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 62e36ed66..c0fa64c90 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -425,7 +425,10 @@
(memoize-variable-access! exp #f))))
(('define (name . x))
- (define! name (eval x env)))
+ (let ((x (eval x env)))
+ (if (and (procedure? x) (not (procedure-property x 'name)))
+ (set-procedure-property! x 'name name))
+ (define! name x)))
(('toplevel-set! (var-or-sym . x))
(variable-set!
diff --git a/test-suite/tests/procprop.test b/test-suite/tests/procprop.test
index 838f7a427..25dd4c293 100644
--- a/test-suite/tests/procprop.test
+++ b/test-suite/tests/procprop.test
@@ -26,7 +26,12 @@
(eq? 'display (procedure-name display)))
(pass-if "gsubr"
- (eq? 'hashq-ref (procedure-name hashq-ref))))
+ (eq? 'hashq-ref (procedure-name hashq-ref)))
+
+ (pass-if "from eval"
+ (eq? 'foobar (procedure-name
+ (eval '(begin (define (foobar) #t) foobar)
+ (current-module))))))
(with-test-prefix "procedure-arity"