test-suite/tests/interp.test

   1 ;;;; interp.test --- tests for bugs in the Guile interpreter -*- scheme -*-
   2 ;;;;
   3 ;;;;    Copyright (C) 1999, 2001 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation; either version 2, or (at your option)
   8 ;;;; any later version.
   9 ;;;;
  10 ;;;; This program is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  18 ;;;; Boston, MA 02110-1301 USA
  19
  20 (pass-if "Internal defines 1"
  21          (letrec ((foo (lambda (arg)
  22                          (or arg (and (procedure? foo)
  23                                       (foo 99))))))
  24            (define bar (foo #f))
  25            (= (foo #f) 99)))
  26
  27 (pass-if "Internal defines 2"
  28          (letrec ((foo 77)
  29                   (bar #f)
  30                   (retfoo (lambda () foo)))
  31            (define baz (retfoo))
  32            (= (retfoo) 77)))
  33
  34 ;; Test that evaluation of closure bodies works as it should
  35
  36 (with-test-prefix "closure bodies"
  37   (with-test-prefix "eval"
  38     (pass-if "expansion"
  39              ;; we really want exactly #f back from the closure
  40              (not ((lambda () (define ret #f) ret))))
  41     (pass-if "iloc escape"
  42              (not (let* ((x #f)
  43                          (foo (lambda () x)))
  44                     (foo) ; causes memoization of x
  45                     (foo)))))
  46   (with-test-prefix "apply"
  47     (pass-if "expansion"
  48              (not (catch #t (lambda () (define ret #f) ret) (lambda a #t))))
  49     (pass-if "iloc escape"
  50              (not (let* ((x #f)
  51                          (foo (lambda () x)))
  52                     (foo)
  53                     (catch #t foo (lambda a #t)))))))