diff options
Diffstat (limited to 'test/automated/generator-tests.el')
-rw-r--r-- | test/automated/generator-tests.el | 284 |
1 files changed, 0 insertions, 284 deletions
diff --git a/test/automated/generator-tests.el b/test/automated/generator-tests.el deleted file mode 100644 index 8ed0f2a240d..00000000000 --- a/test/automated/generator-tests.el +++ /dev/null @@ -1,284 +0,0 @@ -;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. - -;; Author: Daniel Colascione <dancol@dancol.org> -;; Keywords: - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -(require 'generator) -(require 'ert) -(require 'cl-lib) - -(defun generator-list-subrs () - (cl-loop for x being the symbols - when (and (fboundp x) - (cps--special-form-p (symbol-function x))) - collect x)) - -(defmacro cps-testcase (name &rest body) - "Perform a simple test of the continuation-transforming code. - -`cps-testcase' defines an ERT testcase called NAME that evaluates -BODY twice: once using ordinary `eval' and once using -lambda-generators. The test ensures that the two forms produce -identical output. -" - `(progn - (ert-deftest ,name () - (should - (equal - (funcall (lambda () ,@body)) - (iter-next - (funcall - (iter-lambda () (iter-yield (progn ,@body)))))))) - (ert-deftest ,(intern (format "%s-noopt" name)) () - (should - (equal - (funcall (lambda () ,@body)) - (iter-next - (funcall - (let ((cps-inhibit-atomic-optimization t)) - (iter-lambda () (iter-yield (progn ,@body))))))))))) - -(put 'cps-testcase 'lisp-indent-function 1) - -(defvar *cps-test-i* nil) -(defun cps-get-test-i () - *cps-test-i*) - -(cps-testcase cps-simple-1 (progn 1 2 3)) -(cps-testcase cps-empty-progn (progn)) -(cps-testcase cps-inline-not-progn (inline 1 2 3)) -(cps-testcase cps-prog1-a (prog1 1 2 3)) -(cps-testcase cps-prog1-b (prog1 1)) -(cps-testcase cps-prog1-c (prog2 1 2 3)) -(cps-testcase cps-quote (progn 'hello)) -(cps-testcase cps-function (progn #'hello)) - -(cps-testcase cps-and-fail (and 1 nil 2)) -(cps-testcase cps-and-succeed (and 1 2 3)) -(cps-testcase cps-and-empty (and)) - -(cps-testcase cps-or-fallthrough (or nil 1 2)) -(cps-testcase cps-or-alltrue (or 1 2 3)) -(cps-testcase cps-or-empty (or)) - -(cps-testcase cps-let* (let* ((i 10)) i)) -(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i))) -(cps-testcase cps-let (let ((i 10)) i)) -(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i))) -(cps-testcase cps-let-novars (let nil 42)) -(cps-testcase cps-let*-novars (let* nil 42)) - -(cps-testcase cps-let-parallel - (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b)))) - -(cps-testcase cps-let*-parallel - (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b)))) - -(cps-testcase cps-while-dynamic - (setq *cps-test-i* 0) - (while (< *cps-test-i* 10) - (setf *cps-test-i* (+ *cps-test-i* 1))) - *cps-test-i*) - -(cps-testcase cps-while-lexical - (let* ((i 0) (j 10)) - (while (< i 10) - (setf i (+ i 1)) - (setf j (+ j (* i 10)))) - j)) - -(cps-testcase cps-while-incf - (let* ((i 0) (j 10)) - (while (< i 10) - (cl-incf i) - (setf j (+ j (* i 10)))) - j)) - -(cps-testcase cps-dynbind - (setf *cps-test-i* 0) - (let* ((*cps-test-i* 5)) - (cps-get-test-i))) - -(cps-testcase cps-nested-application - (+ (+ 3 5) 1)) - -(cps-testcase cps-unwind-protect - (setf *cps-test-i* 0) - (unwind-protect - (setf *cps-test-i* 1) - (setf *cps-test-i* 2)) - *cps-test-i*) - -(cps-testcase cps-catch-unused - (catch 'mytag 42)) - -(cps-testcase cps-catch-thrown - (1+ (catch 'mytag - (throw 'mytag (+ 2 2))))) - -(cps-testcase cps-loop - (cl-loop for x from 1 to 10 collect x)) - -(cps-testcase cps-loop-backquote - `(a b ,(cl-loop for x from 1 to 10 collect x) -1)) - -(cps-testcase cps-if-branch-a - (if t 'abc)) - -(cps-testcase cps-if-branch-b - (if t 'abc 'def)) - -(cps-testcase cps-if-condition-fail - (if nil 'abc 'def)) - -(cps-testcase cps-cond-empty - (cond)) - -(cps-testcase cps-cond-atomi - (cond (42))) - -(cps-testcase cps-cond-complex - (cond (nil 22) ((1+ 1) 42) (t 'bad))) - -(put 'cps-test-error 'error-conditions '(cps-test-condition)) - -(cps-testcase cps-condition-case - (condition-case - condvar - (signal 'cps-test-error 'test-data) - (cps-test-condition condvar))) - -(cps-testcase cps-condition-case-no-error - (condition-case - condvar - 42 - (cps-test-condition condvar))) - -(ert-deftest cps-generator-basic () - (let* ((gen (iter-lambda () - (iter-yield 1) - (iter-yield 2) - (iter-yield 3) - 4)) - (gen-inst (funcall gen))) - (should (eql (iter-next gen-inst) 1)) - (should (eql (iter-next gen-inst) 2)) - (should (eql (iter-next gen-inst) 3)) - - ;; should-error doesn't catch the generator-end condition (which - ;; isn't an error), so we write our own. - (let (errored) - (condition-case x - (iter-next gen-inst) - (iter-end-of-sequence - (setf errored (cdr x)))) - (should (eql errored 4))))) - -(iter-defun mygenerator (i) - (iter-yield 1) - (iter-yield i) - (iter-yield 2)) - -(ert-deftest cps-test-iter-do () - (let (mylist) - (iter-do (x (mygenerator 4)) - (push x mylist)) - (should (equal mylist '(2 4 1))))) - -(iter-defun gen-using-yield-value () - (let (f) - (setf f (iter-yield 42)) - (iter-yield f) - -8)) - -(ert-deftest cps-yield-value () - (let ((it (gen-using-yield-value))) - (should (eql (iter-next it -1) 42)) - (should (eql (iter-next it -1) -1)))) - -(ert-deftest cps-loop () - (should - (equal (cl-loop for x iter-by (mygenerator 42) - collect x) - '(1 42 2)))) - -(iter-defun gen-using-yield-from () - (let ((sub-iter (gen-using-yield-value))) - (iter-yield (1+ (iter-yield-from sub-iter))))) - -(ert-deftest cps-test-yield-from-works () - (let ((it (gen-using-yield-from))) - (should (eql (iter-next it -1) 42)) - (should (eql (iter-next it -1) -1)) - (should (eql (iter-next it -1) -7)))) - -(defvar cps-test-closed-flag nil) - -(ert-deftest cps-test-iter-close () - (garbage-collect) - (let ((cps-test-closed-flag nil)) - (let ((iter (funcall - (iter-lambda () - (unwind-protect (iter-yield 1) - (setf cps-test-closed-flag t)))))) - (should (equal (iter-next iter) 1)) - (should (not cps-test-closed-flag)) - (iter-close iter) - (should cps-test-closed-flag)))) - -(ert-deftest cps-test-iter-close-idempotent () - (garbage-collect) - (let ((cps-test-closed-flag nil)) - (let ((iter (funcall - (iter-lambda () - (unwind-protect (iter-yield 1) - (setf cps-test-closed-flag t)))))) - (should (equal (iter-next iter) 1)) - (should (not cps-test-closed-flag)) - (iter-close iter) - (should cps-test-closed-flag) - (setf cps-test-closed-flag nil) - (iter-close iter) - (should (not cps-test-closed-flag))))) - -(ert-deftest cps-test-iter-cleanup-once-only () - (let* ((nr-unwound 0) - (iter - (funcall (iter-lambda () - (unwind-protect - (progn - (iter-yield 1) - (error "test") - (iter-yield 2)) - (cl-incf nr-unwound)))))) - (should (equal (iter-next iter) 1)) - (should-error (iter-next iter)) - (should (equal nr-unwound 1)))) - -(iter-defun generator-with-docstring () - "Documentation!" - (declare (indent 5)) - nil) - -(ert-deftest cps-test-declarations-preserved () - (should (equal (documentation 'generator-with-docstring) "Documentation!")) - (should (equal (get 'generator-with-docstring 'lisp-indent-function) 5))) |