test/manual/cycle-tests.el

   1 ;;; Test handling of cyclic and dotted lists    -*- lexical-binding: t; -*-
   2
   3 ;; Copyright 2017 Free Software Foundation, Inc.
   4
   5 ;; Written by Paul Eggert
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (require 'ert)
  21
  22 (defun cyc1 (a)
  23   (let ((ls (make-list 10 a)))
  24     (nconc ls ls)
  25     ls))
  26 (defun cyc2 (a b)
  27   (let ((ls1 (make-list 10 a))
  28         (ls2 (make-list 1000 b)))
  29     (nconc ls2 ls2)
  30     (nconc ls1 ls2)
  31     ls1))
  32
  33 (defun dot1 (a)
  34   (let ((ls (make-list 10 a)))
  35     (nconc ls 'tail)
  36     ls))
  37 (defun dot2 (a b)
  38   (let ((ls1 (make-list 10 a))
  39         (ls2 (make-list 10 b)))
  40     (nconc ls1 ls2)
  41     (nconc ls2 'tail)
  42     ls1))
  43
  44 (ert-deftest test-cycle-length ()
  45   (should-error (length (cyc1 1)) :type 'circular-list)
  46   (should-error (length (cyc2 1 2)) :type 'circular-list)
  47   (should-error (length (dot1 1)) :type 'wrong-type-argument)
  48   (should-error (length (dot2 1 2)) :type 'wrong-type-argument))
  49
  50 (ert-deftest test-cycle-safe-length ()
  51   (should (<= 10 (safe-length (cyc1 1))))
  52   (should (<= 1010 (safe-length (cyc2 1 2))))
  53   (should (= 10 (safe-length (dot1 1))))
  54   (should (= 20 (safe-length (dot2 1 2)))))
  55
  56 (ert-deftest test-cycle-member ()
  57   (let ((c1 (cyc1 1))
  58         (c2 (cyc2 1 2))
  59         (d1 (dot1 1))
  60         (d2 (dot2 1 2)))
  61     (should (member 1 c1))
  62     (should (member 1 c2))
  63     (should (member 1 d1))
  64     (should (member 1 d2))
  65     (should-error (member 2 c1) :type 'circular-list)
  66     (should (member 2 c2))
  67     (should-error (member 2 d1) :type 'wrong-type-argument)
  68     (should (member 2 d2))
  69     (should-error (member 3 c1) :type 'circular-list)
  70     (should-error (member 3 c2) :type 'circular-list)
  71     (should-error (member 3 d1) :type 'wrong-type-argument)
  72     (should-error (member 3 d2) :type 'wrong-type-argument)))
  73
  74 (ert-deftest test-cycle-memq ()
  75   (let ((c1 (cyc1 1))
  76         (c2 (cyc2 1 2))
  77         (d1 (dot1 1))
  78         (d2 (dot2 1 2)))
  79     (should (memq 1 c1))
  80     (should (memq 1 c2))
  81     (should (memq 1 d1))
  82     (should (memq 1 d2))
  83     (should-error (memq 2 c1) :type 'circular-list)
  84     (should (memq 2 c2))
  85     (should-error (memq 2 d1) :type 'wrong-type-argument)
  86     (should (memq 2 d2))
  87     (should-error (memq 3 c1) :type 'circular-list)
  88     (should-error (memq 3 c2) :type 'circular-list)
  89     (should-error (memq 3 d1) :type 'wrong-type-argument)
  90     (should-error (memq 3 d2) :type 'wrong-type-argument)))
  91
  92 (ert-deftest test-cycle-memql ()
  93   (let ((c1 (cyc1 1))
  94         (c2 (cyc2 1 2))
  95         (d1 (dot1 1))
  96         (d2 (dot2 1 2)))
  97     (should (memql 1 c1))
  98     (should (memql 1 c2))
  99     (should (memql 1 d1))
 100     (should (memql 1 d2))
 101     (should-error (memql 2 c1) :type 'circular-list)
 102     (should (memql 2 c2))
 103     (should-error (memql 2 d1) :type 'wrong-type-argument)
 104     (should (memql 2 d2))
 105     (should-error (memql 3 c1) :type 'circular-list)
 106     (should-error (memql 3 c2) :type 'circular-list)
 107     (should-error (memql 3 d1) :type 'wrong-type-argument)
 108     (should-error (memql 3 d2) :type 'wrong-type-argument)))
 109
 110 (ert-deftest test-cycle-assq ()
 111   (let ((c1 (cyc1 '(1)))
 112         (c2 (cyc2 '(1) '(2)))
 113         (d1 (dot1 '(1)))
 114         (d2 (dot2 '(1) '(2))))
 115     (should (assq 1 c1))
 116     (should (assq 1 c2))
 117     (should (assq 1 d1))
 118     (should (assq 1 d2))
 119     (should-error (assq 2 c1) :type 'circular-list)
 120     (should (assq 2 c2))
 121     (should-error (assq 2 d1) :type 'wrong-type-argument)
 122     (should (assq 2 d2))
 123     (should-error (assq 3 c1) :type 'circular-list)
 124     (should-error (assq 3 c2) :type 'circular-list)
 125     (should-error (assq 3 d1) :type 'wrong-type-argument)
 126     (should-error (assq 3 d2) :type 'wrong-type-argument)))
 127
 128 (ert-deftest test-cycle-assoc ()
 129   (let ((c1 (cyc1 '(1)))
 130         (c2 (cyc2 '(1) '(2)))
 131         (d1 (dot1 '(1)))
 132         (d2 (dot2 '(1) '(2))))
 133     (should (assoc 1 c1))
 134     (should (assoc 1 c2))
 135     (should (assoc 1 d1))
 136     (should (assoc 1 d2))
 137     (should-error (assoc 2 c1) :type 'circular-list)
 138     (should (assoc 2 c2))
 139     (should-error (assoc 2 d1) :type 'wrong-type-argument)
 140     (should (assoc 2 d2))
 141     (should-error (assoc 3 c1) :type 'circular-list)
 142     (should-error (assoc 3 c2) :type 'circular-list)
 143     (should-error (assoc 3 d1) :type 'wrong-type-argument)
 144     (should-error (assoc 3 d2) :type 'wrong-type-argument)))
 145
 146 (ert-deftest test-cycle-rassq ()
 147   (let ((c1 (cyc1 '(0 . 1)))
 148         (c2 (cyc2 '(0 . 1) '(0 . 2)))
 149         (d1 (dot1 '(0 . 1)))
 150         (d2 (dot2 '(0 . 1) '(0 . 2))))
 151     (should (rassq 1 c1))
 152     (should (rassq 1 c2))
 153     (should (rassq 1 d1))
 154     (should (rassq 1 d2))
 155     (should-error (rassq 2 c1) :type 'circular-list)
 156     (should (rassq 2 c2))
 157     (should-error (rassq 2 d1) :type 'wrong-type-argument)
 158     (should (rassq 2 d2))
 159     (should-error (rassq 3 c1) :type 'circular-list)
 160     (should-error (rassq 3 c2) :type 'circular-list)
 161     (should-error (rassq 3 d1) :type 'wrong-type-argument)
 162     (should-error (rassq 3 d2) :type 'wrong-type-argument)))
 163
 164 (ert-deftest test-cycle-rassoc ()
 165   (let ((c1 (cyc1 '(0 . 1)))
 166         (c2 (cyc2 '(0 . 1) '(0 . 2)))
 167         (d1 (dot1 '(0 . 1)))
 168         (d2 (dot2 '(0 . 1) '(0 . 2))))
 169     (should (rassoc 1 c1))
 170     (should (rassoc 1 c2))
 171     (should (rassoc 1 d1))
 172     (should (rassoc 1 d2))
 173     (should-error (rassoc 2 c1) :type 'circular-list)
 174     (should (rassoc 2 c2))
 175     (should-error (rassoc 2 d1) :type 'wrong-type-argument)
 176     (should (rassoc 2 d2))
 177     (should-error (rassoc 3 c1) :type 'circular-list)
 178     (should-error (rassoc 3 c2) :type 'circular-list)
 179     (should-error (rassoc 3 d1) :type 'wrong-type-argument)
 180     (should-error (rassoc 3 d2) :type 'wrong-type-argument)))
 181
 182 (ert-deftest test-cycle-delq ()
 183   (should-error (delq 1 (cyc1 1)) :type 'circular-list)
 184   (should-error (delq 1 (cyc2 1 2)) :type 'circular-list)
 185   (should-error (delq 1 (dot1 1)) :type 'wrong-type-argument)
 186   (should-error (delq 1 (dot2 1 2)) :type 'wrong-type-argument)
 187   (should-error (delq 2 (cyc1 1)) :type 'circular-list)
 188   (should-error (delq 2 (cyc2 1 2)) :type 'circular-list)
 189   (should-error (delq 2 (dot1 1)) :type 'wrong-type-argument)
 190   (should-error (delq 2 (dot2 1 2)) :type 'wrong-type-argument)
 191   (should-error (delq 3 (cyc1 1)) :type 'circular-list)
 192   (should-error (delq 3 (cyc2 1 2)) :type 'circular-list)
 193   (should-error (delq 3 (dot1 1)) :type 'wrong-type-argument)
 194   (should-error (delq 3 (dot2 1 2)) :type 'wrong-type-argument))
 195
 196 (ert-deftest test-cycle-delete ()
 197   (should-error (delete 1 (cyc1 1)) :type 'circular-list)
 198   (should-error (delete 1 (cyc2 1 2)) :type 'circular-list)
 199   (should-error (delete 1 (dot1 1)) :type 'wrong-type-argument)
 200   (should-error (delete 1 (dot2 1 2)) :type 'wrong-type-argument)
 201   (should-error (delete 2 (cyc1 1)) :type 'circular-list)
 202   (should-error (delete 2 (cyc2 1 2)) :type 'circular-list)
 203   (should-error (delete 2 (dot1 1)) :type 'wrong-type-argument)
 204   (should-error (delete 2 (dot2 1 2)) :type 'wrong-type-argument)
 205   (should-error (delete 3 (cyc1 1)) :type 'circular-list)
 206   (should-error (delete 3 (cyc2 1 2)) :type 'circular-list)
 207   (should-error (delete 3 (dot1 1)) :type 'wrong-type-argument)
 208   (should-error (delete 3 (dot2 1 2)) :type 'wrong-type-argument))
 209
 210 (ert-deftest test-cycle-reverse ()
 211   (should-error (reverse (cyc1 1)) :type 'circular-list)
 212   (should-error (reverse (cyc2 1 2)) :type 'circular-list)
 213   (should-error (reverse (dot1 1)) :type 'wrong-type-argument)
 214   (should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
 215
 216 (ert-deftest test-cycle-plist-get ()
 217   (let ((c1 (cyc1 1))
 218         (c2 (cyc2 1 2))
 219         (d1 (dot1 1))
 220         (d2 (dot2 1 2)))
 221     (should (plist-get c1 1))
 222     (should (plist-get c2 1))
 223     (should (plist-get d1 1))
 224     (should (plist-get d2 1))
 225     (should-not (plist-get c1 2))
 226     (should (plist-get c2 2))
 227     (should-not (plist-get d1 2))
 228     (should (plist-get d2 2))
 229     (should-not (plist-get c1 3))
 230     (should-not (plist-get c2 3))
 231     (should-not (plist-get d1 3))
 232     (should-not (plist-get d2 3))))
 233
 234 (ert-deftest test-cycle-lax-plist-get ()
 235   (let ((c1 (cyc1 1))
 236         (c2 (cyc2 1 2))
 237         (d1 (dot1 1))
 238         (d2 (dot2 1 2)))
 239     (should (lax-plist-get c1 1))
 240     (should (lax-plist-get c2 1))
 241     (should (lax-plist-get d1 1))
 242     (should (lax-plist-get d2 1))
 243     (should-error (lax-plist-get c1 2) :type 'circular-list)
 244     (should (lax-plist-get c2 2))
 245     (should-not (lax-plist-get d1 2))
 246     (should (lax-plist-get d2 2))
 247     (should-error (lax-plist-get c1 3) :type 'circular-list)
 248     (should-error (lax-plist-get c2 3) :type 'circular-list)
 249     (should-not (lax-plist-get d1 3))
 250     (should-not (lax-plist-get d2 3))))
 251
 252 (ert-deftest test-cycle-plist-member ()
 253   (let ((c1 (cyc1 1))
 254         (c2 (cyc2 1 2))
 255         (d1 (dot1 1))
 256         (d2 (dot2 1 2)))
 257     (should (plist-member c1 1))
 258     (should (plist-member c2 1))
 259     (should (plist-member d1 1))
 260     (should (plist-member d2 1))
 261     (should-error (plist-member c1 2) :type 'circular-list)
 262     (should (plist-member c2 2))
 263     (should-error (plist-member d1 2) :type 'wrong-type-argument)
 264     (should (plist-member d2 2))
 265     (should-error (plist-member c1 3) :type 'circular-list)
 266     (should-error (plist-member c2 3) :type 'circular-list)
 267     (should-error (plist-member d1 3) :type 'wrong-type-argument)
 268     (should-error (plist-member d2 3) :type 'wrong-type-argument)))
 269
 270 (ert-deftest test-cycle-plist-put ()
 271   (let ((c1 (cyc1 1))
 272         (c2 (cyc2 1 2))
 273         (d1 (dot1 1))
 274         (d2 (dot2 1 2)))
 275     (should (plist-put c1 1 1))
 276     (should (plist-put c2 1 1))
 277     (should (plist-put d1 1 1))
 278     (should (plist-put d2 1 1))
 279     (should-error (plist-put c1 2 2) :type 'circular-list)
 280     (should (plist-put c2 2 2))
 281     (should (plist-put d1 2 2))
 282     (should (plist-put d2 2 2))
 283     (should-error (plist-put c1 3 3) :type 'circular-list)
 284     (should-error (plist-put c2 3 3) :type 'circular-list)
 285     (should (plist-put d1 3 3))
 286     (should (plist-put d2 3 3))))
 287
 288 (ert-deftest test-cycle-lax-plist-put ()
 289   (let ((c1 (cyc1 1))
 290         (c2 (cyc2 1 2))
 291         (d1 (dot1 1))
 292         (d2 (dot2 1 2)))
 293     (should (lax-plist-put c1 1 1))
 294     (should (lax-plist-put c2 1 1))
 295     (should (lax-plist-put d1 1 1))
 296     (should (lax-plist-put d2 1 1))
 297     (should-error (lax-plist-put c1 2 2) :type 'circular-list)
 298     (should (lax-plist-put c2 2 2))
 299     (should (lax-plist-put d1 2 2))
 300     (should (lax-plist-put d2 2 2))
 301     (should-error (lax-plist-put c1 3 3) :type 'circular-list)
 302     (should-error (lax-plist-put c2 3 3) :type 'circular-list)
 303     (should (lax-plist-put d1 3 3))
 304     (should (lax-plist-put d2 3 3))))
 305
 306 (ert-deftest test-cycle-equal ()
 307   (should-error (equal (cyc1 1) (cyc1 1)))
 308   (should-error (equal (cyc2 1 2) (cyc2 1 2))))
 309
 310 (ert-deftest test-cycle-nconc ()
 311   (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
 312   (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
 313
 314 (provide 'cycle-tests)