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