diff --git a/test-suite/tests/poe.test b/test-suite/tests/poe.test new file mode 100644 index 000000000..b6022eb78 --- /dev/null +++ b/test-suite/tests/poe.test @@ -0,0 +1,81 @@ +;;;; poe.test --- exercise ice-9/poe.scm -*- scheme -*- +;;;; +;;;; Copyright 2003 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 + +(define-module (test-suite test-ice-9-poe) + #:use-module (test-suite lib) + #:use-module (ice-9 poe)) + + +;; +;; pure-funcq +;; + + +;; +;; perfect-funcq +;; + +(with-test-prefix "perfect-funcq" + + (with-test-prefix "no args" + (define called #f) + (define (foo) + (set! called #t) + 'foo) + + (let ((func (perfect-funcq 31 foo))) + + (pass-if "called first" + (set! called #f) + (and (eq? 'foo (func)) + called)) + + (pass-if "not called second" + (set! called #f) + (and (eq? 'foo (func)) + (not called))))) + + (with-test-prefix "1 arg" + (define called #f) + (define (foo str) + (set! called #t) + (string->number str)) + + (let ((func (perfect-funcq 31 foo))) + (define s1 "123") + (define s2 "123") + + (pass-if "called first s1" + (set! called #f) + (and (= 123 (func s1)) + called)) + + (pass-if "not called second s1" + (set! called #f) + (and (= 123 (func s1)) + (not called))) + + (pass-if "called first s2" + (set! called #f) + (and (= 123 (func s2)) + called)) + + (pass-if "not called second s2" + (set! called #f) + (and (= 123 (func s2)) + (not called))))))