summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2012-01-29 17:43:13 -0500
committerMark H Weaver <mhw@netris.org>2012-01-30 10:27:23 -0500
commitadb8054c6d16d3c5869cd543dbd29c384af02ccd (patch)
tree05297ec3c96ec101802902b98e03e6182a74f1be
parent2f3e436411b5dbb4f1a1b9d8583b348e221d5b67 (diff)
downloadguile-adb8054c6d16d3c5869cd543dbd29c384af02ccd.tar.gz
Fix primitive-eval to return #<unspecified> for definitions
* module/ice-9/eval.scm (primitive-eval): Return #<unspecified> for definitions. Previously the variable object was returned. * test-suite/tests/eval.test (evaluator): Add test. * NEWS: Add news entry.
-rw-r--r--NEWS1
-rw-r--r--module/ice-9/eval.scm3
-rw-r--r--test-suite/tests/eval.test4
3 files changed, 7 insertions, 1 deletions
diff --git a/NEWS b/NEWS
index ce4768631..02b824dff 100644
--- a/NEWS
+++ b/NEWS
@@ -180,6 +180,7 @@ Search the manual for these identifiers and modules, for more.
** Fix erroneous check in `set-procedure-properties!'.
** Fix generalized-vector-{ref,set!} for slices.
** Fix error messages involving definition forms.
+** Fix primitive-eval to return #<unspecified> for definitions.
** HTTP: Extend handling of "Cache-Control" header.
** HTTP: Fix qstring writing of cache-extension values
** HTTP: Fix validators for various list-style headers.
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index c0fa64c90..74b85329d 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -428,7 +428,8 @@
(let ((x (eval x env)))
(if (and (procedure? x) (not (procedure-property x 'name)))
(set-procedure-property! x 'name name))
- (define! name x)))
+ (define! name x)
+ (if #f #f)))
(('toplevel-set! (var-or-sym . x))
(variable-set!
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index b0bfd4c44..a5fbfece2 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -75,6 +75,10 @@
(with-test-prefix "evaluator"
+ (pass-if "definitions return #<unspecified>"
+ (eq? (primitive-eval '(define test-var 'foo))
+ (if #f #f)))
+
(with-test-prefix "symbol lookup"
(with-test-prefix "top level"