-;;;; eval.test --- tests guile's evaluator -*- scheme -*-
-;;;; Copyright (C) 2000 Free Software Foundation, Inc.
-;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-;;;;
-;;;; As a special exception, the Free Software Foundation gives permission
-;;;; for additional uses of the text contained in its release of GUILE.
-;;;;
-;;;; The exception is that, if you link the GUILE library with other files
-;;;; to produce an executable, this does not by itself cause the
-;;;; resulting executable to be covered by the GNU General Public License.
-;;;; Your use of that executable is in no way restricted on account of
-;;;; linking the GUILE library code into it.
-;;;;
-;;;; This exception does not however invalidate any other reasons why
-;;;; the executable file might be covered by the GNU General Public License.
-;;;;
-;;;; This exception applies only to the code released by the
-;;;; Free Software Foundation under the name GUILE. If you copy
-;;;; code from other Free Software Foundation releases into a copy of
-;;;; GUILE, as the General Public License permits, the exception does
-;;;; not apply to the code that you add in this way. To avoid misleading
-;;;; anyone as to the status of such modified files, you must delete
-;;;; this exception notice from them.
-;;;;
-;;;; If you write modifications of your own for GUILE, it is your choice
-;;;; whether to permit this exception to apply to your modifications.
-;;;; If you do not wish that, delete this exception notice.
-
-(use-modules (ice-9 documentation))
-
-
-;;;
-;;; miscellaneous
-;;;
-
-
-(define (documented? object)
- (object-documentation object))
-
-
-;;;
-;;; eval
-;;;
-
-(with-test-prefix "evaluator"
-
- (with-test-prefix "parameter error"
-
- ;; This is currently a bug in guile:
- ;; Macros are accepted as function parameters.
- ;; Functions that 'apply' macros are rewritten!!!
-
- (expect-fail "macro as argument"
- (let ((f (lambda (p a b) (p a b))))
- (catch 'wrong-type-arg
- (lambda ()
- (f and #t #t)
- #f)
- (lambda (key . args)
- #t))))
-
- (expect-fail "application of macro"
- (let ((f (lambda (p a b) (p a b))))
- (catch 'wrong-type-arg
- (lambda ()
- (let ((foo (procedure-source f)))
- (f and #t #t)
- (equal? (procedure-source f) foo)))
- (lambda (key . args)
- #t))))
-
- ))
-
-;;;
-;;; map
-;;;
-
-(with-test-prefix "map"
-
- ;; Is documentation available?
-
- (expect-fail "documented?"
- (documented? 'map))
-
- (with-test-prefix "argument error"
-
- (with-test-prefix "non list argument"
- #t)
-
- (with-test-prefix "different length lists"
-
- (pass-if "first list empty"
- (catch 'out-of-range
- (lambda ()
- (map + '() '(1))
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "second list empty"
- (catch 'out-of-range
- (lambda ()
- (map + '(1) '())
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "first list shorter"
- (catch 'out-of-range
- (lambda ()
- (map + '(1) '(2 3))
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "second list shorter"
- (catch 'out-of-range
- (lambda ()
- (map + '(1 2) '(3))
- #f)
- (lambda (key . args)
- #t)))
- )))
+;;;; eval.test --- tests guile's evaluator -*- scheme -*-
+;;;; Copyright (C) 2000, 2001 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+(use-modules (ice-9 documentation))
+
+
+;;;
+;;; miscellaneous
+;;;
+
+(define (documented? object)
+ (not (not (object-documentation object))))
+
+
+;;;
+;;; eval
+;;;
+
+(with-test-prefix "evaluator"
+
+ (with-test-prefix "memoization"
+
+ (pass-if "transparency"
+ (let ((x '(begin 1)))
+ (eval x (current-module))
+ (equal? '(begin 1) x))))
+
+ (with-test-prefix "symbol lookup"
+
+ (with-test-prefix "top level"
+
+ (with-test-prefix "unbound"
+
+ (pass-if-exception "variable reference"
+ exception:unbound-var
+ x)
+
+ (pass-if-exception "procedure"
+ exception:unbound-var
+ (x)))))
+
+ (with-test-prefix "parameter error"
+
+ ;; This is currently a bug in guile:
+ ;; Macros are accepted as function parameters.
+ ;; Functions that 'apply' macros are rewritten!!!
+
+ (expect-fail-exception "macro as argument"
+ exception:wrong-type-arg
+ (let ((f (lambda (p a b) (p a b))))
+ (f and #t #t)))
+
+ (expect-fail-exception "passing macro as parameter"
+ exception:wrong-type-arg
+ (let* ((f (lambda (p a b) (p a b)))
+ (foo (procedure-source f)))
+ (f and #t #t)
+ (equal? (procedure-source f) foo)))
+
+ ))
+
+;;;
+;;; apply
+;;;
+
+(with-test-prefix "application"
+
+ (with-test-prefix "wrong number of arguments"
+
+ (pass-if-exception "((lambda () #f) 1)"
+ exception:wrong-num-args
+ ((lambda () #f) 1))
+
+ (pass-if-exception "((lambda (x) #f))"
+ exception:wrong-num-args
+ ((lambda (x) #f)))
+
+ (pass-if-exception "((lambda (x) #f) 1 2)"
+ exception:wrong-num-args
+ ((lambda (x) #f) 1 2))
+
+ (pass-if-exception "((lambda (x y) #f))"
+ exception:wrong-num-args
+ ((lambda (x y) #f)))
+
+ (pass-if-exception "((lambda (x y) #f) 1)"
+ exception:wrong-num-args
+ ((lambda (x y) #f) 1))
+
+ (pass-if-exception "((lambda (x y) #f) 1 2 3)"
+ exception:wrong-num-args
+ ((lambda (x y) #f) 1 2 3))
+
+ (pass-if-exception "((lambda (x . rest) #f))"
+ exception:wrong-num-args
+ ((lambda (x . rest) #f)))
+
+ (pass-if-exception "((lambda (x y . rest) #f))"
+ exception:wrong-num-args
+ ((lambda (x y . rest) #f)))
+
+ (pass-if-exception "((lambda (x y . rest) #f) 1)"
+ exception:wrong-num-args
+ ((lambda (x y . rest) #f) 1))))
+
+;;;
+;;; map
+;;;
+
+(with-test-prefix "map"
+
+ ;; Is documentation available?
+
+ (expect-fail "documented?"
+ (documented? map))
+
+ (with-test-prefix "argument error"
+
+ (with-test-prefix "non list argument"
+ #t)
+
+ (with-test-prefix "different length lists"
+
+ (pass-if-exception "first list empty"
+ exception:out-of-range
+ (map + '() '(1)))
+
+ (pass-if-exception "second list empty"
+ exception:out-of-range
+ (map + '(1) '()))
+
+ (pass-if-exception "first list shorter"
+ exception:out-of-range
+ (map + '(1) '(2 3)))
+
+ (pass-if-exception "second list shorter"
+ exception:out-of-range
+ (map + '(1 2) '(3)))
+ )))
+
+;;;
+;;; promises
+;;;
+
+(with-test-prefix "promises"
+
+ (with-test-prefix "basic promise behaviour"
+
+ (pass-if "delay gives a promise"
+ (promise? (delay 1)))
+
+ (pass-if "force evaluates a promise"
+ (eqv? (force (delay (+ 1 2))) 3))
+
+ (pass-if "a forced promise is a promise"
+ (let ((p (delay (+ 1 2))))
+ (force p)
+ (promise? p)))
+
+ (pass-if "forcing a forced promise works"
+ (let ((p (delay (+ 1 2))))
+ (force p)
+ (eqv? (force p) 3)))
+
+ (pass-if "a promise is evaluated once"
+ (let* ((x 1)
+ (p (delay (+ x 1))))
+ (force p)
+ (set! x (+ x 1))
+ (eqv? (force p) 2)))
+
+ (pass-if "a promise may call itself"
+ (define p
+ (let ((x 0))
+ (delay
+ (begin
+ (set! x (+ x 1))
+ (if (> x 1) x (force p))))))
+ (eqv? (force p) 2))
+
+ (pass-if "a promise carries its environment"
+ (let* ((x 1) (p #f))
+ (let* ((x 2))
+ (set! p (delay (+ x 1))))
+ (eqv? (force p) 3)))
+
+ (pass-if "a forced promise does not reference its environment"
+ (let* ((g (make-guardian))
+ (p #f))
+ (let* ((x (cons #f #f)))
+ (g x)
+ (set! p (delay (car x))))
+ (force p)
+ (gc)
+ (if (not (equal? (g) (cons #f #f)))
+ (throw 'unresolved)
+ #t))))
+
+ (with-test-prefix "extended promise behaviour"
+
+ (pass-if-exception "forcing a non-promise object is not supported"
+ exception:wrong-type-arg
+ (force 1))
+
+ (pass-if-exception "implicit forcing is not supported"
+ exception:wrong-type-arg
+ (+ (delay (* 3 7)) 13))))
+
+;;; eval.test ends here
HCoop / bpt / guile.git / blobdiff