elinstall/tests.el

   1 ;;;_ elinstall/tests.el --- Tests for elinstall
   2
   3 ;;;_. Headers
   4 ;;;_ , License
   5 ;; Copyright (C) 2010  Tom Breton (Tehom)
   6
   7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
   8 ;; Keywords: lisp, maint, internal
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;;_ , Commentary:
  26
  27 ;;
  28
  29
  30 ;;;_ , Requires
  31
  32 (require 'elinstall)
  33 (require 'emtest/runner/define)
  34 (require 'emtest/testhelp/standard)
  35 (require 'emtest/testhelp/misc)
  36 (require 'emtest/testhelp/tagnames)
  37 (require 'emtest/testhelp/testpoint)
  38 (require 'emtest/testhelp/mocks/filebuf)
  39 (progn
  40    (eval-when-compile
  41       (require 'emtest/testhelp/testpoint/requirer))
  42    (emtp:require))
  43
  44 (require 'cus-edit) ;;Because we save "installedness" manually
  45
  46
  47 ;;;_. Body
  48 ;;;_ ,
  49 (defconst elinstall:th:examples
  50    (emtb:expand-filename-by-load-file "examples")
  51    "Directory of example files" )
  52
  53 ;;;_ , Insulation
  54 ;;;_  . elinstall:th:surrounders
  55 (defconst elinstall:th:surrounders
  56    ;;Mock customize-save-variable to do nothing.
  57    ;;Also mock interaction: yes-or-no-p.  This suggests that I should
  58    ;;articulate the package more, to separate interaction.
  59    '((emtp:insulate (customize-save-variable)))
  60    "The normal surrounders for elinstall tests" )
  61
  62 ;;;_ , Tests
  63 (emt:deftest-3
  64    ((of 'elinstall-already-installed)
  65       (:surrounders elinstall:th:surrounders))
  66
  67    (nil
  68       (let
  69          ((elinstall-already-installed nil))
  70          (emt:doc "Situation: Nothing has been installed.")
  71          (emt:doc "Operation: Query whether EXAMPLE has been installed.")
  72          (emt:doc "Response: give nil.")
  73          (assert
  74             (not
  75                (elinstall-already-installed "example")))
  76
  77          (emt:doc "Operation: Record that EXAMPLE has been installed.")
  78
  79          (elinstall-record-installed "example")
  80          (emt:doc "Operation: Query whether EXAMPLE has been installed.")
  81          (emt:doc "Response: give true.")
  82          (assert
  83             (elinstall-already-installed "example")))))
  84
  85 ;;;_ , Generating the right actions
  86 (emt:deftest-3 elinstall-find-actions-by-spec
  87    ;;At least one for each command.
  88    ;;(dir)
  89    ;;Also test recursing in directories
  90    (nil
  91       (progn
  92          (emt:doc "Situation: On examples/1 directory.")
  93          (emt:doc "Response: WRITEME."))))
  94
  95
  96 ;;;_ , Given list of actions, segregate it right.
  97 ;;;_  . Examples
  98 (defconst elinstall:td:examples
  99    (let
 100       ((dir (expand-file-name "2/" elinstall:th:examples)))
 101       (emtg:define+
 102          ()
 103          (transparent-tags () (type name))
 104
 105          ;;The actions themselves:
 106          (group ((type action))
 107             (group ((subtype add-file-autoloads))
 108                (group ((target 1))
 109                   (item ((qname 'a1))
 110                      `(add-file-autoloads "deffile-1"
 111                          "a1"
 112                          ,dir
 113                          ,(expand-file-name "a1.el" dir)))
 114
 115                   (item ((qname 'b))
 116                      `(add-file-autoloads "deffile-1" "b1" ,dir
 117                          ,(expand-file-name "b1.el" dir))))
 118                (group ((target 2))
 119                   (item ((qname 'c))
 120                      `(add-file-autoloads "deffile-2"
 121                          "c2"
 122                          ,dir
 123                          ,(expand-file-name "c2.el" dir)))
 124
 125                   (item ((qname 'd))
 126                      `(add-file-autoloads "deffile-2" "d2" ,dir
 127                          ,(expand-file-name "d2.el" dir)))))
 128             (group ((subtype add-to-load-path))
 129                (item ((target 1)(qname 'alp1))
 130                   `(add-to-load-path   "deffile-1" ,dir))
 131                (item ((target 2)(qname 'alp2))
 132                   `(add-to-load-path   "deffile-2" ,dir)))
 133
 134             (group ((subtype add-to-info-path))
 135                (item ((target 1)(qname 'aip1))
 136                   `(add-to-info-path   "deffile-1" ,dir))
 137                (item ((target 2)(qname 'aip2))
 138                   `(add-to-info-path   "deffile-2" ,dir)))
 139
 140             (group ((subtype preload-file))
 141                (item ((target 1)(qname 'plf1))
 142                   `(preload-file "deffile-1" 50))
 143                (item ((target 2)(qname 'plf2))
 144                   `(preload-file "deffile-2"))
 145                (item ((target 3)(qname 'plf3))
 146                   `(preload-file "deffile-3"))))
 147
 148          ;;Empty list
 149          (group ((name 0))
 150             (item ((type action-list))
 151                '())
 152             (item ((type segment-list))
 153                '()))
 154          ;;List all pointing towards the same deffile
 155          (group ((name 1))
 156             (item ((type action-list))
 157                `(
 158                   ,(emtg (type action)(target 1)(qname 'a1))
 159                   ,(emtg (type action)(target 1)(qname 'b))))
 160
 161
 162             (item ((type segment-list))
 163                `(("deffile-1"
 164                     ,(emtg (type action)(target 1)(qname 'a1))
 165                     ,(emtg (type action)(target 1)(qname 'b))))))
 166
 167          ;;List pointing towards two deffiles
 168          (group ((name 2))
 169             (item ((type action-list))
 170                `(
 171                    ,(emtg (type action)(target 1)(qname 'a1))
 172                    ,(emtg (type action)(target 2)(qname 'c))
 173                    ,(emtg (type action)(target 1)(qname 'b))
 174                    ,(emtg (type action)(target 2)(qname 'd))))
 175
 176             (item ((type segment-list))
 177                `(("deffile-1"
 178                     ,(emtg (type action)(target 1)(qname 'a1))
 179                     ,(emtg (type action)(target 1)(qname 'b)))
 180                    ("deffile-2"
 181                       ,(emtg (type action)(target 2)(qname 'c))
 182                       ,(emtg (type action)(target 2)(qname 'd))))))
 183
 184          ;;List including all types except preload actions
 185          (group ((name 3))
 186             (item ((type action-list))
 187                `(
 188                    ,(emtg (type action)(subtype add-to-info-path)
 189                       (target 1))
 190                    ,(emtg (type action)(subtype add-to-load-path)
 191                          (target 2))
 192                    ,(emtg (type action)(target 1)(qname 'a1))
 193                    ,(emtg (type action)(target 2)(qname 'c))
 194                    ,(emtg (type action)(target 1)(qname 'b))
 195                    ,(emtg (type action)(target 2)(qname 'd))
 196                    ,(emtg (type action)(subtype add-to-info-path)
 197                       (target 2))
 198                    ,(emtg (type action)(subtype add-to-load-path)
 199                          (target 1))))
 200
 201
 202             (item ((type segment-list))
 203                `(
 204                    ("deffile-1"
 205                       ,(emtg (type action)(subtype add-to-info-path)
 206                          (target 1))
 207                       ,(emtg (type action)(subtype add-to-load-path)
 208                          (target 1))
 209                       ,(emtg (type action)(target 1)(qname 'a1))
 210                       ,(emtg (type action)(target 1)(qname 'b)))
 211                    ("deffile-2"
 212                       ,(emtg (type action)(target 2)(qname 'c))
 213                       ,(emtg (type action)(target 2)(qname 'd))
 214                       ,(emtg (type action)(subtype add-to-info-path)
 215                          (target 2))
 216                       ,(emtg (type action)(subtype add-to-load-path)
 217                          (target 2))))))
 218
 219          ;;List including some preload actions
 220          (group ((name 4))
 221             (item ((type action-list))
 222                `(
 223                    ,(emtg (type action)(subtype preload-file)
 224                          (target 1))
 225                    ,(emtg (type action)(target 1)(qname 'a1))
 226                    ,(emtg (type action)(target 2)(qname 'c))
 227                    ,(emtg (type action)(subtype preload-file)
 228                          (target 2))
 229                    ,(emtg (type action)(target 1)(qname 'b))
 230                    ,(emtg (type action)(target 2)(qname 'd))
 231                    ,(emtg (type action)(subtype preload-file)
 232                          (target 3))))
 233
 234             (item ((type segment-list))
 235                `(
 236                    (nil
 237                       ,(emtg (type action)(subtype preload-file)
 238                          (target 1))
 239                       ,(emtg (type action)(subtype preload-file)
 240                          (target 2))
 241                       ,(emtg (type action)(subtype preload-file)
 242                          (target 3)))
 243
 244                    ("deffile-1"
 245                       ,(emtg (type action)(target 1)(qname 'a1))
 246                       ,(emtg (type action)(target 1)(qname 'b)))
 247
 248                    ("deffile-2"
 249                       ,(emtg (type action)(target 2)(qname 'c))
 250                       ,(emtg (type action)(target 2)(qname 'd))))))
 251
 252          ;;List includes some null actions
 253          (group ((name 5))
 254             (item ((type action-list))
 255                `(
 256                    nil
 257                    ,(emtg (type action)(target 1)(qname 'a1))
 258                    nil
 259                    ,(emtg (type action)(target 2)(qname 'c))
 260                    nil
 261                    ,(emtg (type action)(target 1)(qname 'b))
 262                    ,(emtg (type action)(target 2)(qname 'd))))
 263
 264             (item ((type segment-list))
 265                `(("deffile-1"
 266                     ,(emtg (type action)(target 1)(qname 'a1))
 267                     ,(emtg (type action)(target 1)(qname 'b)))
 268                    ("deffile-2"
 269                       ,(emtg (type action)(target 2)(qname 'c))
 270                       ,(emtg (type action)(target 2)(qname 'd)))))))))
 271
 272 ;;;_  . elinstall-remove-autogen-action
 273 (emt:deftest-3 elinstall-remove-autogen-action
 274    (nil
 275       (emtg:with elinstall:td:examples ()
 276          (emt:doc "Param: List of actions including an
 277    add-file-autoloads for a1.")
 278          (emt:doc "Param: filename a1.")
 279          (emt:doc "Response: The a1 action is removed.")
 280          (assert
 281             (equal
 282                (elinstall-remove-autogen-action
 283                   "a1"
 284                   '(
 285                       (emtg (type action)(target 1)(name 'a))
 286                       (add-file-autoloads "deffile-1" "b1")))
 287                '((add-file-autoloads "deffile-1" "b1")))
 288
 289             t))))
 290
 291
 292 ;;;_  . elinstall-segregate-actions
 293
 294 (emt:deftest-3 elinstall-segregate-actions
 295    (nil
 296       (emtg:with elinstall:td:examples ()
 297          (emtg:map name name
 298             (let*
 299                ((segment-list
 300                    (elinstall-segregate-actions
 301                       (emtg (type action-list)))))
 302
 303                (assert
 304                   (emth:sets=
 305                      segment-list
 306                      (emtg (type segment-list))
 307                      :test
 308                      #'(lambda (a b)
 309                           (and
 310                              (equal (car a)(car b))
 311                              (emth:sets=
 312                                 (cdr a)(cdr b)))))
 313                   t))))))
 314
 315 ;;;_ , Given list of actions, doing the right adds to deffile
 316 ;;Similar requirements for `elinstall-do-segment'
 317 (emt:deftest-3 elinstall-update-deffile
 318    ;;Test that when called multiple times, it updates right:
 319    ;;Removes gone files.
 320    ;;Autoloads with slash-path if asked to (That requires another setup)
 321    ;;That will use function 31a1-1 in 31a1.el
 322    ;;Check it by autoloading it.
 323
 324    ;;load-path is just to "3/"
 325    ;;(For add-to-load-path)
 326    ;;Doesn't make the same add-to-load-path section twice
 327    ;;
 328    (nil
 329       (emtg:with elinstall:td:examples
 330       (let*
 331          ((elinsert:th:found '())
 332             (dir
 333                (expand-file-name "2/" elinstall:th:examples))
 334                     ;;Because the load will sometimes set it.
 335             (load-path (list dir)))
 336
 337
 338          (emtb:with-file-f (:absent :visited-name 'tmp) x
 339             (emt:doc "Case: Only one autoload")
 340             (emt:doc "Situation: elinsert:th:found is an empty list
 341    and all the autoloads in question push symbols to it.")
 342             (emt:doc "Operation: update the def file")
 343             (elinstall-update-deffile x
 344                `(
 345                    ,(emtg (type action)(target 1)(qname 'a1)))
 346                (list dir))
 347             (emt:doc "Operation: load the def file")
 348             (load-file x)
 349             (emt:doc "Response: It has done what was expected")
 350             (assert
 351                (equal elinsert:th:found '(a1))))))))
 352 ;;;_ , elinstall-remove-autogen-action
 353 ;;Test that it removes on the same sort of filename that
 354 ;;elinstall-generate-file-autoloads hands to it.
 355 ;;elinstall-get-autogen-action, same requirement.
 356
 357 ;;;_. Footers
 358 ;;;_ , Provides
 359
 360 (provide 'elinstall/tests)
 361
 362 ;;;_ * Local emacs vars.
 363 ;;;_  + Local variables:
 364 ;;;_  + mode: allout
 365 ;;;_  + End:
 366
 367 ;;;_ , End
 368 ;;; elinstall/tests.el ends here