cgit.sxemacs.org Git - sxemacs/blob - tests/automated/cl-loop-tests.el

   1 ;;;  cl-tests.el -- Tests for CL
   2 ;; Copyright (C) 2006, 2007 Sebastian Freundt
   3 ;;
   4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
   5 ;; Keywords: tests
   6 ;;
   7 ;; This file is part of SXEmacs.
   8 ;;
   9 ;; Redistribution and use in source and binary forms, with or without
  10 ;; modification, are permitted provided that the following conditions
  11 ;; are met:
  12 ;;
  13 ;; 1. Redistributions of source code must retain the above copyright
  14 ;;    notice, this list of conditions and the following disclaimer.
  15 ;;
  16 ;; 2. Redistributions in binary form must reproduce the above copyright
  17 ;;    notice, this list of conditions and the following disclaimer in the
  18 ;;    documentation and/or other materials provided with the distribution.
  19 ;;
  20 ;; 3. Neither the name of the author nor the names of any contributors
  21 ;;    may be used to endorse or promote products derived from this
  22 ;;    software without specific prior written permission.
  23 ;;
  24 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35 ;;
  36 ;;; Synched up with: Not in FSF.
  37 ;;
  38 ;;; Commentary:
  39 ;; See test-harness.el for instructions on how to run these tests.
  40
  41 (eval-when-compile
  42   (condition-case nil
  43       (require 'test-harness)
  44     (file-error
  45      (push "." load-path)
  46      (when (and (boundp 'load-file-name) (stringp load-file-name))
  47        (push (file-name-directory load-file-name) load-path))
  48      (require 'test-harness))))
  49
  50 ;;;###eval-me-first
  51 (and (featurep 'modules)
  52      (locate-module "cl-loop")
  53      (require 'cl-loop))
  54
  55 (when (featurep 'cl-loop)
  56   ;;; do/dotimes/dolist tests
  57   (Assert
  58    (eq (cl:do ((temp-one 1 (1+ temp-one))
  59                (temp-two 0 (1- temp-two)))
  60               ((> (- temp-one temp-two) 5) temp-one)) 4))
  61   (Assert
  62    (eq (cl:do ((temp-one 1 (1+ temp-one))
  63                (temp-two 0 (1+ temp-one)))
  64               ((= 3 temp-two) temp-one)) 3))
  65   (Assert
  66    (eq (cl:do* ((temp-one 1 (1+ temp-one))
  67                 (temp-two 0 (1+ temp-one)))
  68                ((= 3 temp-two) temp-one)) 2))
  69
  70   (cl:dotimes (i 10 j)
  71               (setq j (1+ i)))
  72   (Assert (= j 10))
  73
  74   (cl:dolist (i '(1 2 17) j)
  75              (setq j (1+ i)))
  76   (Assert (= j 18))
  77
  78   (Assert (null (cl:do-symbols (i))))
  79   (Assert (null (cl:do-all-symbols (i))))
  80
  81
  82   ;;; loop tests
  83   (let* ((coll 0))
  84     (cl:loop for i from -2 do (incf coll))
  85     (Assert (= coll 3)))
  86   (let* ((coll 0))
  87     (cl:loop for i downto -2 do (incf coll))
  88     (Assert (= coll 3)))
  89   (let* ((coll 0))
  90     (cl:loop for i above -2 do (incf coll))
  91     (Assert (= coll 2)))
  92   (let* ((coll 0))
  93     (cl:loop for i below 2 do (incf coll))
  94     (Assert (= coll 2)))
  95   (let* ((coll 0))
  96     (cl:loop for i to 20 by 10 do (incf coll))
  97     (Assert (= coll 3)))
  98   (let* ((coll 0))
  99     (cl:loop for i below 20 by 10 do (incf coll))
 100     (Assert (= coll 2)))
 101   (let* ((coll 0))
 102     (cl:loop for i downto -20 by 10 do (incf coll))
 103     (Assert (= coll 3)))
 104   (let* ((coll 0))
 105     (cl:loop for i downfrom 20 by 10 do (incf coll))
 106     (Assert (= coll 3)))
 107
 108   (let* ((coll 0))
 109     (cl:loop
 110      for i to 20
 111      for j below 10
 112      do (incf coll))
 113     (Assert (= coll 10)))
 114
 115   ;; testing epilogue clauses
 116   (Assert
 117    (equal
 118     (cl:loop with a = 1
 119              with b = (+ a 2)
 120              with c = (+ b 3)
 121              return (list a b c))
 122     '(1 3 6)))
 123
 124   (Assert
 125    (equal
 126     (let* ((a 0)
 127            (b 0)
 128            (c 0))
 129       (cl:loop with a = 1
 130                and b = (+ a 2)
 131                and c = (+ b 3)
 132                return (list a b c)))
 133     '(1 2 3)))
 134
 135   (Assert
 136    (equal
 137     (let* ((a 0)
 138            (b 0)
 139            (c 0))
 140       (cl:loop with a = 1
 141                and b = (+ a 2)
 142                and c = (+ b 3)
 143                finally (setq b a)
 144                return b))
 145     1))
 146
 147   (Assert
 148    (equal
 149     (let* ((a 0)
 150            (b 0)
 151            (c 0))
 152       (cl:loop with a = 1
 153                and b = (+ a 2)
 154                and c = (+ b 3)
 155                initially (setq a 100)
 156                finally (setq b a)
 157                return b))
 158     100))
 159
 160   ;; multi-for
 161   (Assert
 162    (equal
 163     (cl:loop for x from 1 to 10
 164              for y = nil then x
 165              collect (list x y))
 166     '((1 nil) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10))))
 167
 168   (Assert
 169    (equal
 170     (cl:loop for x from 1 to 10
 171              and y = nil then x
 172              collect (list x y))
 173     '((1 nil) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9))))
 174
 175   ;; accumulation COLLECT
 176   (if (featurep 'bigz)
 177       (Assert
 178        (equal
 179         (cl:loop as i across [1 2 3 4 5 6 7 8 9 10]
 180                  collect (and (primep i) i))
 181         '(nil 2 3 nil 5 nil 7 nil nil nil)))
 182     (Assert
 183      (equal
 184       (cl:loop as i across [1 2 3 4 5 6 7 8 9 10]
 185                collect (and (evenp i) i))
 186       '(nil 2 nil 4 nil 6 nil 8 nil 10))))
 187
 188   ;; accumulation COUNT
 189   (Assert
 190    (=
 191     (cl:loop for i in '(a nil b nil c d nil e)
 192              count i)
 193     5))
 194
 195   (Assert
 196    (equal
 197     (cl:loop for i in '(a nil b nil c d nil e)
 198              count i into foo
 199              return (list i foo))
 200     '(e 5)))
 201
 202   (Assert
 203    (=
 204     (cl:loop for i in '(a nil b nil c d nil e)
 205              count i into foo
 206              count (null i) into bar
 207              return bar)
 208     3))
 209
 210   (Assert
 211    (=
 212     (cl:loop for i in '(a nil b nil c d nil e)
 213              count i into foo
 214              ;; last count should be returned anyway
 215              count (null i) into bar)
 216     3))
 217
 218   (Assert
 219    (=
 220     (cl:loop for i in '(a nil b nil c d nil e)
 221              count (eq i t))
 222     0))
 223
 224   (Assert
 225    (=
 226     (cl:loop for i in '(a nil b nil c d nil e)
 227              count (memq i '(a b)))
 228     2))
 229
 230   ;; accumulation SUM
 231   (Assert
 232    (=
 233     (cl:loop for i in '(1 2 3 4 5)
 234              sum i)
 235     15))
 236
 237   (Assert
 238    (=
 239     (cl:loop for i in '(1 2 3 4)
 240              sum (* 2.0 i))
 241     20.0))
 242
 243   (Assert
 244    (= (let* ((series '(1.25 4.5 5.5)))
 245         (cl:loop for v in series
 246                  sum (* 2.0 v)))
 247       22.5))
 248
 249   (Assert
 250    (=
 251     (cl:loop for i in '(1 2 3 4)
 252              sum (* 2.0 i))
 253     20.0))
 254
 255   (Assert
 256    (=
 257     (cl:loop for i in '(1 2 3 4)
 258              sum (* -2 i) into bar
 259              sum bar)
 260     -40))
 261
 262   ;; accumulate MAXIMISE/MINIMISE
 263   (Assert
 264    (=
 265     (cl:loop for i in '(1 2 3 4 3 2 1)
 266              maximise i)
 267     4))
 268
 269   (Assert
 270    (=
 271     (cl:loop for i in '(1 2 3 4 3 2 1)
 272              minimise i)
 273     1))
 274
 275   (Assert
 276    (equal
 277     (cl:loop for i in '(1 2 3 4 3 2 1)
 278              maximise (1+ i) into foo
 279              minimise (1- i) into bar
 280              return (list foo bar))
 281     '(5 0)))
 282
 283   (Assert
 284    (equal
 285     (cl:loop as i across [1 2 3 4 3 2 1]
 286              maximise (1+ i) into foo
 287              minimise (1- i) into bar
 288              return (list foo bar))
 289     '(5 0)))
 290
 291   (Assert
 292    (=
 293     (cl:loop for i on '(1 2 3 4 3 2 1)
 294              maximise (length i))
 295     7))
 296   )
 297 ;;; cl-loop-tests.el ends here