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