test-suite/tests/eval.test

   1 ;;;; eval.test --- tests guile's evaluator     -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the GNU Lesser General Public
   6 ;;;; License as published by the Free Software Foundation; either
   7 ;;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;; Lesser General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU Lesser General Public
  15 ;;;; License along with this library; if not, write to the Free Software
  16 ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  17
  18 (define-module (test-suite test-eval)
  19   :use-module (test-suite lib)
  20   :use-module (ice-9 documentation))
  21
  22
  23 (define exception:bad-expression
  24   (cons 'syntax-error "Bad expression"))
  25
  26
  27 ;;;
  28 ;;; miscellaneous
  29 ;;;
  30
  31 (define (documented? object)
  32   (not (not (object-documentation object))))
  33
  34
  35 ;;;
  36 ;;; memoization
  37 ;;;
  38
  39 (with-test-prefix "memoization"
  40
  41   (with-test-prefix "copy-tree"
  42
  43     (pass-if "(#t . #(#t))"
  44       (let* ((foo (cons #t (vector #t)))
  45              (bar (copy-tree foo)))
  46         (vector-set! (cdr foo) 0 #f)
  47         (equal? bar '(#t . #(#t)))))
  48
  49     (pass-if-exception "circular lists in forms"
  50       exception:bad-expression
  51       (let ((foo (list #f)))
  52         (set-cdr! foo foo)
  53         (copy-tree foo))))
  54
  55   (pass-if "transparency"
  56     (let ((x '(begin 1)))
  57       (eval x (current-module))
  58       (equal? '(begin 1) x))))
  59
  60
  61 ;;;
  62 ;;; eval
  63 ;;;
  64
  65 (with-test-prefix "evaluator"
  66
  67   (with-test-prefix "symbol lookup"
  68
  69     (with-test-prefix "top level"
  70
  71       (with-test-prefix "unbound"
  72
  73         (pass-if-exception "variable reference"
  74           exception:unbound-var
  75           x)
  76
  77         (pass-if-exception "procedure"
  78           exception:unbound-var
  79           (x)))))
  80
  81   (with-test-prefix "parameter error"
  82
  83     ;; This is currently a bug in guile:
  84     ;; Macros are accepted as function parameters.
  85     ;; Functions that 'apply' macros are rewritten!!!
  86
  87     (expect-fail-exception "macro as argument"
  88       exception:wrong-type-arg
  89       (let ((f (lambda (p a b) (p a b))))
  90         (f and #t #t)))
  91
  92     (expect-fail-exception "passing macro as parameter"
  93       exception:wrong-type-arg
  94       (let* ((f (lambda (p a b) (p a b)))
  95              (foo (procedure-source f)))
  96         (f and #t #t)
  97         (equal? (procedure-source f) foo)))
  98
  99     ))
 100
 101 ;;;
 102 ;;; apply
 103 ;;;
 104
 105 (with-test-prefix "application"
 106
 107   (with-test-prefix "wrong number of arguments"
 108
 109     (pass-if-exception "((lambda () #f) 1)"
 110       exception:wrong-num-args
 111       ((lambda () #f) 1))
 112
 113     (pass-if-exception "((lambda (x) #f))"
 114       exception:wrong-num-args
 115       ((lambda (x) #f)))
 116
 117     (pass-if-exception "((lambda (x) #f) 1 2)"
 118       exception:wrong-num-args
 119       ((lambda (x) #f) 1 2))
 120
 121     (pass-if-exception "((lambda (x y) #f))"
 122       exception:wrong-num-args
 123       ((lambda (x y) #f)))
 124
 125     (pass-if-exception "((lambda (x y) #f) 1)"
 126       exception:wrong-num-args
 127       ((lambda (x y) #f) 1))
 128
 129     (pass-if-exception "((lambda (x y) #f) 1 2 3)"
 130       exception:wrong-num-args
 131       ((lambda (x y) #f) 1 2 3))
 132
 133     (pass-if-exception "((lambda (x . rest) #f))"
 134       exception:wrong-num-args
 135       ((lambda (x . rest) #f)))
 136
 137     (pass-if-exception "((lambda (x y . rest) #f))"
 138       exception:wrong-num-args
 139       ((lambda (x y . rest) #f)))
 140
 141     (pass-if-exception "((lambda (x y . rest) #f) 1)"
 142       exception:wrong-num-args
 143       ((lambda (x y . rest) #f) 1))))
 144
 145 ;;;
 146 ;;; map
 147 ;;;
 148
 149 (with-test-prefix "map"
 150
 151   ;; Is documentation available?
 152
 153   (expect-fail "documented?"
 154     (documented? map))
 155
 156   (with-test-prefix "argument error"
 157
 158     (with-test-prefix "non list argument"
 159       #t)
 160
 161     (with-test-prefix "different length lists"
 162
 163       (pass-if-exception "first list empty"
 164         exception:out-of-range
 165         (map + '() '(1)))
 166
 167       (pass-if-exception "second list empty"
 168         exception:out-of-range
 169         (map + '(1) '()))
 170
 171       (pass-if-exception "first list shorter"
 172         exception:out-of-range
 173         (map + '(1) '(2 3)))
 174
 175       (pass-if-exception "second list shorter"
 176         exception:out-of-range
 177         (map + '(1 2) '(3)))
 178     )))
 179
 180 ;;;
 181 ;;; promises
 182 ;;;
 183
 184 (with-test-prefix "promises"
 185
 186   (with-test-prefix "basic promise behaviour"
 187
 188     (pass-if "delay gives a promise"
 189       (promise? (delay 1)))
 190
 191     (pass-if "force evaluates a promise"
 192       (eqv? (force (delay (+ 1 2))) 3))
 193
 194     (pass-if "a forced promise is a promise"
 195       (let ((p (delay (+ 1 2))))
 196         (force p)
 197         (promise? p)))
 198
 199     (pass-if "forcing a forced promise works"
 200       (let ((p (delay (+ 1 2))))
 201         (force p)
 202         (eqv? (force p) 3)))
 203
 204     (pass-if "a promise is evaluated once"
 205       (let* ((x 1)
 206              (p (delay (+ x 1))))
 207         (force p)
 208         (set! x (+ x 1))
 209         (eqv? (force p) 2)))
 210
 211     (pass-if "a promise may call itself"
 212       (define p
 213         (let ((x 0))
 214           (delay
 215             (begin
 216               (set! x (+ x 1))
 217               (if (> x 1) x (force p))))))
 218       (eqv? (force p) 2))
 219
 220     (pass-if "a promise carries its environment"
 221       (let* ((x 1) (p #f))
 222         (let* ((x 2))
 223           (set! p (delay (+ x 1))))
 224         (eqv? (force p) 3)))
 225
 226     (pass-if "a forced promise does not reference its environment"
 227       (let* ((g (make-guardian))
 228              (p #f))
 229         (let* ((x (cons #f #f)))
 230           (g x)
 231           (set! p (delay (car x))))
 232         (force p)
 233         (gc)
 234         (if (not (equal? (g) (cons #f #f)))
 235             (throw 'unresolved)
 236             #t))))
 237
 238   (with-test-prefix "extended promise behaviour"
 239
 240     (pass-if-exception "forcing a non-promise object is not supported"
 241       exception:wrong-type-arg
 242       (force 1))
 243
 244     (pass-if-exception "implicit forcing is not supported"
 245       exception:wrong-type-arg
 246       (+ (delay (* 3 7)) 13))))
 247
 248 ;;; eval.test ends here