code.delx.au - gnu-emacs-elpa/blob - packages/stream/tests/stream-tests.el

   1 ;;; stream-tests.el --- Unit tests for stream.el  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6
   7 ;; Maintainer: emacs-devel@gnu.org
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;; Code:
  26
  27 (require 'ert)
  28 (require 'stream)
  29 (require 'cl-lib)
  30
  31 (defun stream-to-list (stream)
  32   "Eagerly traverse STREAM and return a list of its elements."
  33   (let (result)
  34     (seq-do (lambda (elt)
  35                  (push elt result))
  36                stream)
  37     (reverse result)))
  38
  39 (ert-deftest stream-empty-test ()
  40   (should (streamp (stream-empty)))
  41   (should (stream-empty-p (stream-empty))))
  42
  43 (ert-deftest stream-make-test ()
  44   (should (streamp (stream-range)))
  45   (should (not (stream-empty-p (stream-range))))) ;; Should use stream-list or something
  46
  47 (ert-deftest stream-first-test ()
  48   (should (= 3 (stream-first (stream-range 3))))
  49   (should (null (stream-first (stream-empty)))))
  50
  51 (ert-deftest stream-rest-test ()
  52   (should (= 4 (stream-first (stream-rest (stream-range 3)))))
  53   (should (= 5 (stream-first (stream-rest (stream-rest (stream-range 3)))))))
  54
  55 (ert-deftest stream-from-iterator-test ()
  56   (skip-unless (require 'generator nil t))
  57   (should (equal '(1 2)
  58                  (seq-into-sequence
  59                   (stream-from-iterator
  60                    (funcall (iter-lambda ()
  61                               (iter-yield 1)
  62                               (iter-yield 2))))))))
  63
  64 (ert-deftest stream-append-test ()
  65   (should (stream-empty-p (stream-append)))
  66   (should (let ((list '(1 2)))
  67             (equal list (seq-into-sequence (stream-append (stream list))))))
  68   (should (= (seq-elt (stream-append
  69                        (stream (list 0 1))
  70                        (stream-range 2))
  71                       4)
  72              4))
  73   (should (let ((stream (stream (list 0))))
  74             (and (= (seq-elt (stream-append stream (stream-range 1)) 10)
  75                     10)
  76                  (stream-empty-p (stream-rest stream)))))
  77   (should (equal (seq-into-sequence
  78                   (stream-append
  79                    (stream '(1))
  80                    (stream '())
  81                    (stream '(2 3))))
  82                  '(1 2 3))))
  83
  84 (ert-deftest stream-seqp-test ()
  85   (should (seqp (stream-range))))
  86
  87 (ert-deftest stream-seq-elt-test ()
  88   (should (null (seq-elt (stream-empty) 0)))
  89   (should (= 0 (seq-elt (stream-range) 0)))
  90   (should (= 1 (seq-elt (stream-range) 1)))
  91   (should (= 10 (seq-elt (stream-range) 10))))
  92
  93 (ert-deftest stream-seq-length-test ()
  94   (should (zerop (seq-length (stream-empty))))
  95   (should (= 10 (seq-length (stream-range 0 10)))))
  96
  97 (ert-deftest stream-seq-doseq-test ()
  98   (let ((stream (stream '(a b c d)))
  99         (lst '()))
 100     (seq-doseq (elt stream)
 101       (push elt lst))
 102     (should (equal '(d c b a) lst))))
 103
 104 (ert-deftest stream-seq-let-test ()
 105   (seq-let (first _ third &rest rest) (stream-range 2 7)
 106     (should (= first 2))
 107     (should (= third 4))
 108     ;; The rest of the stream shouldn't be consumed
 109     (should (streamp rest))
 110     (should (= 5 (stream-first rest)))
 111     (should (= 6 (stream-first (stream-rest rest))))
 112     (should (stream-empty-p (stream-rest (stream-rest rest))))))
 113
 114 (ert-deftest stream-seq-subseq-test ()
 115   ;; TODO
 116   )
 117
 118 (ert-deftest stream-seq-into-test ()
 119   (should (streamp (seq-into (stream-empty) 'stream)))
 120   (should (streamp (seq-into '(2 4 5) 'stream)))
 121   (should (= 2  (stream-first (seq-into '(2 4 5) 'stream))))
 122   (should (null (seq-into (stream-empty) 'list)))
 123   (should (equal '(0 1 2 3 4 5 6 7 8 9) (seq-into (stream-range 0 10) 'list))))
 124
 125 (ert-deftest stream-seq-take-test ()
 126   (should (streamp (seq-take (stream-range) 2)))
 127   (should (= 0 (stream-first (seq-take (stream-range) 2))))
 128   (should (= 1 (stream-first (stream-rest (seq-take (stream-range) 2)))))
 129   (should (null (stream-first (stream-rest (stream-rest (seq-take (stream-range) 2))))))
 130   (should (stream-empty-p (stream-rest (stream-rest (seq-take (stream-range) 2))))))
 131
 132 (ert-deftest stream-seq-drop-test ()
 133   (should (streamp (seq-drop (stream-range) 2)))
 134   (should (= 2 (stream-first (seq-drop (stream-range) 2))))
 135   (should (= 3 (stream-first (stream-rest (seq-drop (stream-range) 2)))))
 136   (should (stream-empty-p (seq-drop (stream-empty) 2))))
 137
 138 (ert-deftest stream-seq-take-while-test ()
 139   (let ((stream (stream '(1 3 2 5))))
 140     (should (stream-empty-p (seq-take-while #'identity (stream-empty))))
 141     (should (streamp (seq-take-while #'cl-oddp stream)))
 142     (should (= 1 (stream-first (seq-take-while #'cl-oddp stream))))
 143     (should (= 3 (stream-first (stream-rest (seq-take-while #'cl-oddp stream)))))
 144     (should (stream-empty-p (stream-rest (stream-rest (seq-take-while #'cl-oddp stream)))))))
 145
 146 (ert-deftest stream-seq-drop-while-test ()
 147   (let ((stream (stream '(1 3 2 5))))
 148     (should (streamp (seq-drop-while #'cl-evenp stream)))
 149     (should (stream-empty-p (seq-drop-while #'identity (stream-empty))))
 150     (should (= 2 (stream-first (seq-drop-while #'cl-evenp stream))))
 151     (should (= 5 (stream-first (stream-rest (seq-drop-while #'cl-evenp stream)))))
 152     (should (stream-empty-p (stream-rest (stream-rest (seq-drop-while #'cl-evenp stream)))))))
 153
 154 (ert-deftest stream-seq-map-test ()
 155   (should (stream-empty-p (seq-map #'- (stream-empty))))
 156   (should (= -1 (stream-first (seq-map #'- (stream-range 1)))))
 157   (should (= -2 (stream-first (stream-rest (seq-map #'- (stream-range 1)))))))
 158
 159 (ert-deftest stream-seq-do-test ()
 160   (let ((result '()))
 161     (seq-do
 162      (lambda (elt)
 163        (push elt result))
 164      (stream-range 0 5))
 165     (should (equal result '(4 3 2 1 0)))))
 166
 167 (ert-deftest stream-seq-filter-test ()
 168   (should (stream-empty-p (seq-filter #'cl-oddp (stream-empty))))
 169   (should (stream-empty-p (seq-filter #'cl-oddp (stream-range 0 4 2))))
 170   (should (= 1 (stream-first (seq-filter #'cl-oddp (stream-range 0 4)))))
 171   (should (= 3 (stream-first (stream-rest (seq-filter #'cl-oddp (stream-range 0 4))))))
 172   (should (stream-empty-p (stream-rest (stream-rest (seq-filter #'cl-oddp (stream-range 0 4)))))))
 173
 174 (ert-deftest stream-delay-test ()
 175   (should (streamp (stream-delay (stream-range))))
 176   (should (= 0 (stream-first (stream-delay (stream-range)))))
 177   (should (= 1 (stream-first (stream-rest (stream-delay (stream-range))))))
 178   (should (let ((stream (stream-range 3 7)))
 179             (equal (seq-into (stream-delay stream) 'list)
 180                    (seq-into               stream  'list))))
 181   (should (null (seq-into (stream-delay (stream-empty)) 'list)))
 182   (should (let* ((evaluated nil)
 183                  (one-plus (lambda (el)
 184                              (setq evaluated t)
 185                              (1+ el)))
 186                  (stream (seq-map one-plus (stream '(1)))))
 187             (equal '(nil 2 t)
 188                    (list evaluated (stream-first stream) evaluated))))
 189   (should (let* ((a 0)
 190                  (set-a (lambda (x) (setq a x)))
 191                  (s (stream-delay (stream (list a))))
 192                  res1 res2)
 193             (funcall set-a 5)
 194             (setq res1 (stream-first s))
 195             (funcall set-a 11)
 196             (setq res2 (stream-first s))
 197             (and (equal res1 5)
 198                  (equal res2 5)))))
 199
 200 (ert-deftest stream-seq-copy-test ()
 201   (should (streamp (seq-copy (stream-range))))
 202   (should (= 0 (stream-first (seq-copy (stream-range)))))
 203   (should (= 1 (stream-first (stream-rest (seq-copy (stream-range))))))
 204   (should (let ((stream (stream-range 3 7)))
 205             (equal (seq-into (seq-copy stream) 'list)
 206                    (seq-into stream 'list))))
 207   (should (null (seq-into (seq-copy (stream-empty)) 'list))))
 208
 209 (ert-deftest stream-range-test ()
 210   (should (stream-empty-p (stream-range 0 0)))
 211   (should (stream-empty-p (stream-range 3 3)))
 212   (should (= 0 (stream-first (stream-range 0 6 2))))
 213   (should (= 2 (stream-first (stream-rest (stream-range 0 6 2)))))
 214   (should (= 4 (stream-first (stream-rest (stream-rest (stream-range 0 6 2))))))
 215   (should (stream-empty-p (stream-rest (stream-rest (stream-rest (stream-range 0 6 2))))))
 216   (should (= -4 (stream-first (stream-rest (stream-rest (stream-range 0 nil -2)))))))
 217
 218 (ert-deftest stream-list-test ()
 219   (dolist (list '(nil '(1 2 3) '(a . b)))
 220     (should (equal list (stream-to-list (stream list))))))
 221
 222 (ert-deftest stream-seq-subseq-test ()
 223   (should (stream-empty-p (seq-subseq (stream-range 2 10) 0 0)))
 224   (should (= (stream-first (seq-subseq (stream-range 2 10) 0 3)) 2))
 225   (should (= (seq-length (seq-subseq (stream-range 2 10) 0 3)) 3))
 226   (should (= (seq-elt (seq-subseq (stream-range 2 10) 0 3) 2) 4))
 227   (should (= (stream-first (seq-subseq (stream-range 2 10) 1 3)) 3))
 228   (should (= (seq-length (seq-subseq (stream-range 2 10) 1 3)) 2))
 229   (should (= (seq-elt (seq-subseq (stream-range 2 10) 1 3) 1) 4)))
 230
 231 (ert-deftest stream-seq-map-should-not-consume-stream-elements ()
 232   (let* (consumed
 233          (stream (stream-cons (setq consumed t) (stream-empty))))
 234     (seq-map #'identity stream)
 235     (should-not consumed)))
 236
 237 (ert-deftest stream-pop-test ()
 238   (let* ((str (stream '(1 2 3)))
 239          (first (stream-pop str))
 240          (stream-empty (stream-empty)))
 241     (should (= 1 first))
 242     (should (= 2 (stream-first str)))
 243     (should (null (stream-pop stream-empty)))))
 244
 245 (ert-deftest stream-scan-test ()
 246   (should (eq (seq-elt (stream-scan #'* 1 (stream-range 1)) 4) 24)))
 247
 248 (ert-deftest stream-flush-test ()
 249   (should (let* ((times 0)
 250                  (count (lambda () (cl-incf times))))
 251             (letrec ((make-test-stream (lambda () (stream-cons (progn (funcall count) nil)
 252                                                           (funcall make-test-stream)))))
 253               (stream-flush (seq-take (funcall make-test-stream) 5))
 254               (eq times 5)))))
 255
 256 (ert-deftest stream-iterate-function-test ()
 257   (should (equal (list 0 1 2) (seq-into-sequence (seq-take (stream-iterate-function #'1+ 0) 3)))))
 258
 259 (ert-deftest stream-concatenate-test ()
 260   (should (equal (seq-into-sequence
 261                   (stream-concatenate
 262                    (stream (list (stream (list 1 2 3))
 263                                  (stream (list))
 264                                  (stream (list 4))
 265                                  (stream (list 5 6 7 8 9))))))
 266                  (list 1 2 3 4 5 6 7 8 9))))
 267
 268 (provide 'stream-tests)
 269 ;;; stream-tests.el ends here