set names of functions defined at the toplevel from `eval'

* module/ice-9/eval.scm (primitive-eval): Set the name of
  toplevel-defined functions.

diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 62e36ed..c0fa64c 100644 (file)
--- 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 838f7a4..25dd4c2 100644 (file)
--- 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))))))
 
 \f
 (with-test-prefix "procedure-arity"