diff options
Diffstat (limited to 'test-suite/tests/eval.test')
-rw-r--r-- | test-suite/tests/eval.test | 44 |
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 |