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          (group ((type filename))
 106             (item
 107                ((qname 'deffile-1))
 108                ;;But it might not be made in this directory, but
 109                ;;rather in a tmp directory.
 110                "deffile-1")
 111             (item
 112                ((qname 'a1))
 113                (expand-file-name "a1.el" dir)))
 114
 115          ;;The actions themselves:
 116          (group ((type action))
 117             (group ((subtype add-file-autoloads))
 118                (group ((target 1))
 119                   (item ((qname 'a1))
 120                      `(add-file-autoloads "deffile-1"
 121                          "a1"
 122                          ,dir
 123                          ,(expand-file-name "a1.el" dir)))
 124
 125                   (item ((qname 'b))
 126                      `(add-file-autoloads "deffile-1" "b1" ,dir
 127                          ,(expand-file-name "b1.el" dir))))
 128                (group ((target 2))
 129                   (item ((qname 'c))
 130                      `(add-file-autoloads "deffile-2"
 131                          "c2"
 132                          ,dir
 133                          ,(expand-file-name "c2.el" dir)))
 134
 135                   (item ((qname 'd))
 136                      `(add-file-autoloads "deffile-2" "d2" ,dir
 137                          ,(expand-file-name "d2.el" dir)))))
 138             (group ((subtype add-to-load-path))
 139                (item ((target 1)(qname 'alp1))
 140                   `(add-to-load-path   "deffile-1" ,dir))
 141                (item ((target 2)(qname 'alp2))
 142                   `(add-to-load-path   "deffile-2" ,dir)))
 143
 144             (group ((subtype add-to-info-path))
 145                (item ((target 1)(qname 'aip1))
 146                   `(add-to-info-path   "deffile-1" ,dir))
 147                (item ((target 2)(qname 'aip2))
 148                   `(add-to-info-path   "deffile-2" ,dir)))
 149
 150             (group ((subtype preload-file))
 151                (item ((target 1)(qname 'plf1))
 152                   `(preload-file "deffile-1" 50))
 153                (item ((target 2)(qname 'plf2))
 154                   `(preload-file "deffile-2"))
 155                (item ((target 3)(qname 'plf3))
 156                   `(preload-file "deffile-3"))))
 157
 158          ;;$$OBSOLETE.  All segments are now under stuff.
 159          ;;Empty list
 160          (group ((name 0))
 161             (item ((type action-list))
 162                '())
 163             (item ((type segment-list))
 164                '()))
 165          ;;List all pointing towards the same deffile
 166          (group ((name 1))
 167             (item ((type action-list))
 168                `(
 169                   ,(emtg (type action)(target 1)(qname 'a1))
 170                   ,(emtg (type action)(target 1)(qname 'b))))
 171
 172
 173             (item ((type segment-list))
 174                `(("deffile-1"
 175                     ,(emtg (type action)(target 1)(qname 'a1))
 176                     ,(emtg (type action)(target 1)(qname 'b))))))
 177
 178          ;;List pointing towards two deffiles
 179          (group ((name 2))
 180             (item ((type action-list))
 181                `(
 182                    ,(emtg (type action)(target 1)(qname 'a1))
 183                    ,(emtg (type action)(target 2)(qname 'c))
 184                    ,(emtg (type action)(target 1)(qname 'b))
 185                    ,(emtg (type action)(target 2)(qname 'd))))
 186
 187             (item ((type segment-list))
 188                `(("deffile-1"
 189                     ,(emtg (type action)(target 1)(qname 'a1))
 190                     ,(emtg (type action)(target 1)(qname 'b)))
 191                    ("deffile-2"
 192                       ,(emtg (type action)(target 2)(qname 'c))
 193                       ,(emtg (type action)(target 2)(qname 'd))))))
 194
 195          ;;List including all types except preload actions
 196          (group ((name 3))
 197             (item ((type action-list))
 198                `(
 199                    ,(emtg (type action)(subtype add-to-info-path)
 200                       (target 1))
 201                    ,(emtg (type action)(subtype add-to-load-path)
 202                          (target 2))
 203                    ,(emtg (type action)(target 1)(qname 'a1))
 204                    ,(emtg (type action)(target 2)(qname 'c))
 205                    ,(emtg (type action)(target 1)(qname 'b))
 206                    ,(emtg (type action)(target 2)(qname 'd))
 207                    ,(emtg (type action)(subtype add-to-info-path)
 208                       (target 2))
 209                    ,(emtg (type action)(subtype add-to-load-path)
 210                          (target 1))))
 211
 212
 213             (item ((type segment-list))
 214                `(
 215                    ("deffile-1"
 216                       ,(emtg (type action)(subtype add-to-info-path)
 217                          (target 1))
 218                       ,(emtg (type action)(subtype add-to-load-path)
 219                          (target 1))
 220                       ,(emtg (type action)(target 1)(qname 'a1))
 221                       ,(emtg (type action)(target 1)(qname 'b)))
 222                    ("deffile-2"
 223                       ,(emtg (type action)(target 2)(qname 'c))
 224                       ,(emtg (type action)(target 2)(qname 'd))
 225                       ,(emtg (type action)(subtype add-to-info-path)
 226                          (target 2))
 227                       ,(emtg (type action)(subtype add-to-load-path)
 228                          (target 2))))))
 229
 230          ;;List including some preload actions
 231          (group ((name 4))
 232             (item ((type action-list))
 233                `(
 234                    ,(emtg (type action)(subtype preload-file)
 235                          (target 1))
 236                    ,(emtg (type action)(target 1)(qname 'a1))
 237                    ,(emtg (type action)(target 2)(qname 'c))
 238                    ,(emtg (type action)(subtype preload-file)
 239                          (target 2))
 240                    ,(emtg (type action)(target 1)(qname 'b))
 241                    ,(emtg (type action)(target 2)(qname 'd))
 242                    ,(emtg (type action)(subtype preload-file)
 243                          (target 3))))
 244
 245             (item ((type segment-list))
 246                `(
 247                    ("deffile-1"
 248                       ,(emtg (type action)(target 1)(qname 'a1))
 249                       ,(emtg (type action)(target 1)(qname 'b)))
 250
 251                    ("deffile-2"
 252                       ,(emtg (type action)(target 2)(qname 'c))
 253                       ,(emtg (type action)(target 2)(qname 'd)))
 254                    (nil
 255                       ,(emtg (type action)(subtype preload-file)
 256                           (target 1))
 257                       ,(emtg (type action)(subtype preload-file)
 258                           (target 2))
 259                       ,(emtg (type action)(subtype preload-file)
 260                           (target 3))))))
 261
 262          ;;List includes some null actions
 263          (group ((name 5))
 264             (item ((type action-list))
 265                `(
 266                    nil
 267                    ,(emtg (type action)(target 1)(qname 'a1))
 268                    nil
 269                    ,(emtg (type action)(target 2)(qname 'c))
 270                    nil
 271                    ,(emtg (type action)(target 1)(qname 'b))
 272                    ,(emtg (type action)(target 2)(qname 'd))))
 273
 274             (item ((type segment-list))
 275                `(("deffile-1"
 276                     ,(emtg (type action)(target 1)(qname 'a1))
 277                     ,(emtg (type action)(target 1)(qname 'b)))
 278                    ("deffile-2"
 279                       ,(emtg (type action)(target 2)(qname 'c))
 280                       ,(emtg (type action)(target 2)(qname 'd)))))))))
 281
 282 ;;;_  . elinstall-remove-autogen-action
 283 (emt:deftest-3 elinstall-remove-autogen-action
 284    (nil
 285       (emtg:with elinstall:td:examples ()
 286          (emt:doc "Param: List of actions including an
 287    add-file-autoloads for a1.")
 288          (emt:doc "Param: filename a1.")
 289          (emt:doc "Response: The a1 action is removed.")
 290          (assert
 291             (equal
 292                (elinstall-remove-autogen-action
 293                   "a1"
 294                   '(
 295                       (emtg (type action)(target 1)(name 'a))
 296                       (add-file-autoloads "deffile-1" "b1")))
 297                '((add-file-autoloads "deffile-1" "b1")))
 298
 299             t))))
 300
 301
 302 ;;;_  . elinstall-segregate-actions
 303
 304 (emt:deftest-3 elinstall-segregate-actions
 305    (nil
 306       (emtg:with elinstall:td:examples ()
 307          (emtg:map name name
 308             (let*
 309                ((segment-list
 310                    (elinstall-segregate-actions
 311                       (emtg (type action-list)))))
 312
 313                (assert
 314                   (emth:sets=
 315                      segment-list
 316                      (emtg (type segment-list))
 317                      :test
 318                      #'(lambda (a b)
 319                           (and
 320                              (equal (car a)(car b))
 321                              (emth:sets=
 322                                 (cdr a)(cdr b)))))
 323                   t))))))
 324 ;;;_  . elinstall-get-relevant-load-path
 325 (emt:deftest-3 elinstall-get-relevant-load-path
 326    (nil
 327       (emtg:with elinstall:td:examples ()
 328          (emt:doc "Situation: Some actions are add-to-load-path.")
 329          (emt:doc "Response: Return exactly a list of these.")
 330          ;;$$WRITE MY EXAMPLES for results comparison.
 331          (elinstall-get-relevant-load-path
 332             (emtg (type action-list) (name 3))))))
 333
 334
 335
 336 ;;;_ , Given list of actions, doing the right adds to deffile
 337 ;;Similar requirements for `elinstall-do-segment'
 338 (emt:deftest-3 elinstall-update-deffile
 339    ;;$$WRITE ME
 340    ;;Test that when called multiple times, it updates right:
 341    ;;$$WRITE ME
 342    ;;Removes gone files.
 343    ;;$$WRITE ME
 344    ;;Autoloads with slash-path if asked to (That requires another setup)
 345    ;;That will use function 31a1-1 in 31a1.el
 346    ;;Check it by autoloading it.
 347
 348    ;;load-path is just to "3/"
 349    ;;$$WRITE ME
 350    ;;(For add-to-load-path)
 351    ;;Doesn't make the same add-to-load-path section twice
 352    ;;
 353    (nil
 354       (emtg:with elinstall:td:examples
 355       (let*
 356          ((elinsert:th:found '())
 357             (dir
 358                (expand-file-name "2/" elinstall:th:examples))
 359                     ;;Because the load will sometimes set it.
 360             (load-path (list dir)))
 361
 362
 363          (emtb:with-file-f (:absent :visited-name 'tmp) x
 364             (emt:doc "Case: Only one autoload")
 365             (emt:doc "Situation: elinsert:th:found is an empty list
 366    and all the autoloads in question push symbols to it.")
 367             (emt:doc "Operation: update the def file")
 368             (elinstall-update-deffile x
 369                `(
 370                    ,(emtg (type action)(target 1)(qname 'a1)))
 371                (list dir))
 372             (emt:doc "Operation: load the def file")
 373             (load-file x)
 374             (emt:doc "Response: It has done what was expected")
 375             (assert
 376                (equal elinsert:th:found '(a1))))))))
 377 ;;;_ , elinstall-remove-autogen-action
 378 ;;Test that it removes on the same sort of filename that
 379 ;;elinstall-generate-file-autoloads hands to it.
 380 ;;elinstall-get-autogen-action, same requirement.
 381 ;;;_ , elinstall-symlink-on-emacs-start
 382
 383 (emt:deftest-3 elinstall-symlink-on-emacs-start
 384    (nil
 385       (emtg:with elinstall:td:examples ()
 386          (emtmd:with-dirtree (:repr '())
 387             (emt:doc "Situation: Directory exists and is empty.")
 388             (emt:doc "Operation: Symlink into it.")
 389             (emt:doc "PARAM: force flag not passed.")
 390
 391             (elinstall-symlink-on-emacs-start
 392                (emtg (type filename)(qname 'a1)) "apreload"
 393                default-directory 50)
 394
 395             (let*
 396                ((repr-contents
 397                    (emtmd:get-repr-contents ".")))
 398
 399                (emt:doc
 400                   "Response: Now contains a symlink of the expected name.")
 401                ;;$$IMPROVE MY SUPPORT dirtree doesn't yet allow
 402                ;;testing for type = symlink
 403                (assert
 404                   (emtmd:repr-contents-equal
 405                      repr-contents
 406                      (emtmd:make-repr-contents
 407                         (emtmd:make-repr-file "50apreload.el")))
 408                   t))))))
 409
 410 ;;;_ , elinstall-arrange-preload
 411
 412 (emt:deftest-3 elinstall-arrange-preload
 413    (nil
 414       (emtg:with elinstall:td:examples ()
 415          (emtmd:with-dirtree (:repr '())
 416             (emt:doc "Situation: Directory exists and is empty.")
 417             (emt:doc "Operation: Symlink into it.")
 418             (emt:doc "PARAM: force flag not passed.")
 419
 420             (let*
 421                ((elinstall-default-preload-target default-directory))
 422                (elinstall-arrange-preload
 423                   nil
 424                   (emtg (type filename)(qname 'a1))
 425                   "apreload"
 426                50))
 427
 428             (let*
 429                ((repr-contents
 430                    (emtmd:get-repr-contents ".")))
 431
 432                (emt:doc
 433                   "Response: Now contains a symlink of the expected name.")
 434                ;;$$IMPROVE MY SUPPORT dirtree doesn't yet allow
 435                ;;testing for type = symlink
 436                (assert
 437                   (emtmd:repr-contents-equal
 438                      repr-contents
 439                      (emtmd:make-repr-contents
 440                         (emtmd:make-repr-file "50apreload.el")))
 441                   t))))))
 442
 443 ;;;_. Footers
 444 ;;;_ , Provides
 445
 446 (provide 'elinstall/tests)
 447
 448 ;;;_ * Local emacs vars.
 449 ;;;_  + Local variables:
 450 ;;;_  + mode: allout
 451 ;;;_  + End:
 452
 453 ;;;_ , End
 454 ;;; elinstall/tests.el ends here