summaryrefslogtreecommitdiff
path: root/test-suite/tests/eval.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/eval.test')
-rw-r--r--test-suite/tests/eval.test44
1 files changed, 43 insertions, 1 deletions
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 4adf0312f..519e2c0a1 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -1,5 +1,5 @@
;;;; eval.test --- tests guile's evaluator -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2007 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
@@ -202,6 +202,33 @@
)))
;;;
+;;; define with procedure-name
+;;;
+
+(define old-procnames-flag (memq 'procnames (debug-options)))
+(debug-enable 'procnames)
+
+;; names are only set on top-level procedures (currently), so these can't be
+;; hidden in a let
+;;
+(define foo-closure (lambda () "hello"))
+(define bar-closure foo-closure)
+(define foo-pws (make-procedure-with-setter car set-car!))
+(define bar-pws foo-pws)
+
+(with-test-prefix "define set procedure-name"
+
+ (pass-if "closure"
+ (eq? 'foo-closure (procedure-name bar-closure)))
+
+ (pass-if "procedure-with-setter"
+ (eq? 'foo-pws (pk (procedure-name bar-pws)))))
+
+(if old-procnames-flag
+ (debug-enable 'procnames)
+ (debug-disable 'procnames))
+
+;;;
;;; promises
;;;
@@ -288,5 +315,20 @@
'(a b c d e f g h i j k l m
n o p q r s t u v w x y z))))
+;;;
+;;; values
+;;;
+
+(with-test-prefix "values"
+
+ (pass-if "single value"
+ (equal? 1 (values 1)))
+
+ (pass-if "call-with-values"
+ (equal? (call-with-values (lambda () (values 1 2 3 4)) list)
+ '(1 2 3 4)))
+
+ (pass-if "equal?"
+ (equal? (values 1 2 3 4) (values 1 2 3 4))))
;;; eval.test ends here