Changeset 25477 in project for release/4/ugarit/trunk/test/run.scm


Ignore:
Timestamp:
11/06/11 10:07:42 (10 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Unit test suite now covers everything except fold-archive-node over directories (but that's really hard to test, and really simple to implement, so not worth testing, right?)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/ugarit/trunk/test/run.scm

    r22628 r25477  
    44(use test)
    55(use posix)
     6(use posix-extras)
    67(use directory-rules)
     8(use matchable)
    79(include "../backend-devtools.scm")
    810(include "../backend-cache.scm")
     
    8284   (test-assert "Archive is in initial state" (null? (directory store-path))))
    8385
     86(define (check-extract-results path plain-file1-contents plain-file2-contents)
     87  (let* ((tp (lambda (relative) (string-append path "/" relative)))
     88         (check-file (lambda (relative contents)
     89                       (when contents
     90                             (test (sprintf "Contents of ~s are as expected" relative)
     91                                   contents
     92                                   (with-input-from-file (tp relative) read))))))
     93
     94    ;; Plain file(s)
     95    (check-file "plain-file1" plain-file1-contents)
     96    (check-file "plain-file2" plain-file2-contents)
     97
     98    ;; FIFO
     99    (test-assert "FIFO exists" (fifo? (tp "fifo")))
     100
     101    ;; Specials
     102    (if (zero? (current-user-id))
     103        (begin
     104          (let* ((stats (file-stat (tp "block-special")))
     105                 (type (bitwise-and (vector-ref stats 1) stat/ifmt))
     106                 (devnum (vector-ref stats 10)))
     107            (test-assert "Block special file exists" (eq? type stat/ifblk))
     108            (test "Block special file has correct devnum" 123 devnum))
     109
     110          (let* ((stats (file-stat (tp "character-special")))
     111                 (type (bitwise-and (vector-ref stats 1) stat/ifmt))
     112                 (devnum (vector-ref stats 10)))
     113            (test-assert "Character special file exists" (eq? type stat/ifchr))
     114            (tets "Character special file has correct devnum" 456 devnum))))
     115
     116    ;; Directory
     117    (test-assert "Directory exists" (directory? (tp "directory")))))
     118
    84119(define (test-archive a store-path)
    85120   (if (archive-unlinkable? a)
     
    322357   (test-group "Directories"
    323358               (let* ((test-dir (string-append store-path "-test-data"))
    324                       (extract-dir (string-append store-path "-test-extract"))
     359                      (extract1-dir (string-append store-path "-test-extract1"))
     360                      (extract2-dir (string-append store-path "-test-extract2"))
     361                      (extract3-dir (string-append store-path "-test-extract3"))
     362                      (extract4-dir (string-append store-path "-test-extract4"))
    325363                      (tp (lambda (relative)
    326364                            (string-append test-dir "/" relative))))
    327365                 (create-directory test-dir)
    328                  (with-output-to-file (tp "plain-file") (lambda () (write "Hello world")))
     366                 (with-output-to-file (tp "plain-file1") (lambda () (write "Hello world")))
    329367                 (create-fifo (tp "fifo"))
    330                  #;(create-special-file (tp "block-special") stat/ifblk 123)
    331                  #;(create-special-file (tp "character-special") stat/ifchr 456)
     368                 ;; These two need root!
     369                 (if (zero? (current-user-id))
     370                     (begin
     371                       (create-special-file (tp "block-special") stat/ifblk 123)
     372                       (create-special-file (tp "character-special") stat/ifchr 456)))
    332373                 (create-directory (tp "directory"))
    333374
    334                  (test-define-values "Store a directory" (dir-key dir-reused?)
     375                 ;; Dump it
     376                 (test-define-values "Store a directory" (dir1-key dir1-reused?)
    335377                                     (call-with-context-support
    336378                                      (archive-global-directory-rules a)
     
    338380                                       (store-directory! a test-dir))))
    339381
    340                  (create-directory extract-dir)
     382                 (create-directory extract1-dir)
    341383
    342384                 (test "Extract a directory" (void)
    343                        (extract-directory! a dir-key extract-dir))
    344 
    345                  ;; FIXME: Compare the contents of test-dir and extract-dir?
    346 
     385                       (extract-directory! a dir1-key extract1-dir))
     386
     387                 (check-extract-results extract1-dir "Hello world" #f)
     388
     389                 ;; Now add an extra file and dump again
     390                 (with-output-to-file (tp "plain-file2") (lambda () (write "Hello world 2")))
     391
     392                 (test-define-values "Store a directory again" (dir2-key dir2-reused?)
     393                                     (call-with-context-support
     394                                      (archive-global-directory-rules a)
     395                                      (lambda ()
     396                                       (store-directory! a test-dir))))
     397
     398                 (test-assert "Changed directory is not reused" (not dir2-reused?))
     399
     400                 (create-directory extract2-dir)
     401                 (test "Extract a directory" (void)
     402                       (extract-directory! a dir2-key extract2-dir))
     403
     404                 (check-extract-results extract2-dir "Hello world" "Hello world 2")
     405
     406                 ;; Now change an existing file and dump again
     407                 (with-output-to-file (tp "plain-file1") (lambda () (write "Hello world again!")))
     408
     409                 (test-define-values "Store a directory again" (dir3-key dir3-reused?)
     410                                     (call-with-context-support
     411                                      (archive-global-directory-rules a)
     412                                      (lambda ()
     413                                       (store-directory! a test-dir))))
     414
     415                 (test-assert "Changed directory is not reused" (not dir3-reused?))
     416
     417                 (create-directory extract3-dir)
     418                 (test "Extract a directory" (void)
     419                       (extract-directory! a dir3-key extract3-dir))
     420
     421                 (check-extract-results extract3-dir "Hello world again!" "Hello world 2")
     422
     423                 ;; Now make no changes and dump again
     424                 (test-define-values "Store a directory again" (dir4-key dir4-reused?)
     425                                     (call-with-context-support
     426                                      (archive-global-directory-rules a)
     427                                      (lambda ()
     428                                       (store-directory! a test-dir))))
     429
     430                 (test-assert "Unchanged directory is reused" dir4-reused?)
     431                 (test "Mark reused directory" (void) (archive-link! a dir4-key))
     432                 (create-directory extract4-dir)
     433                 (test "Extract a directory" (void)
     434                       (extract-directory! a dir4-key extract4-dir))
     435                 (check-extract-results extract4-dir "Hello world again!" "Hello world 2")
     436
     437                 ;; Tidy up
    347438                 (if (archive-unlinkable? a)
    348439                     (begin
    349                        (test "Delete the directory" (void) (unlink-directory! a dir-key))
     440                       (test "Delete the first directory" (void) (unlink-directory! a dir1-key))
     441                       (check-extract-results extract2-dir "Hello world" "Hello world 2")
     442                       (test "Delete the second directory" (void) (unlink-directory! a dir2-key))
     443                       (check-extract-results extract3-dir "Hello world again!" "Hello world 2")
     444                       (test "Delete the third directory" (void) (unlink-directory! a dir3-key))
     445                       (check-extract-results extract4-dir "Hello world again!" "Hello world 2")
     446                       (test "Delete the fourth directory" (void) (unlink-directory! a dir4-key))
    350447                       (check-dir-is-empty store-path)))))
    351 #|
    352    
    353    (printf "snapshots\n")
    354 
    355    (printf "\tStore a directory\n")
    356    
    357    (define-values (dir-key dir-reused?)
    358       (store-directory! archive "test-data"))
    359 
    360    (if (archive-unlinkable? a)
    361       (assert (not dir-reused?)))
    362 
    363    (printf "\tTag it (~A ~A)\n" dir-key dir-reused?)
    364    (define sk1 (tag-snapshot! archive "Test" dir-key dir-reused? (list)))
    365    
    366    (printf "\tStore another directory\n")
    367 
    368    (define-values (dir-key-two dir-reused?)
    369       (store-directory! archive "test-data"))
    370    
    371    (assert dir-reused?)
    372    (assert (string=? dir-key dir-key-two))
    373    
    374    (printf "\tTag it (~A ~A)\n" dir-key  dir-reused?)
    375    (define sk1 (tag-snapshot! archive "Test" dir-key-two dir-reused? (list)))
    376    
    377    (printf "\tWalk the history\n")
    378    
    379    (define result
    380       (fold-history archive (archive-tag archive "Test")
    381          (lambda (snapshot-key snapshot acc)
    382             (cons snapshot acc))
    383          '()))
    384    (assert (match result
    385      (((('previous . sk1)
    386         ('mtime . _)
    387         ('contents . dir-key-two))
    388        (('mtime . _)
    389         ('contents . dir-key))) #t)
    390      (else #f)))
    391    
    392    ;(printf "\tTest fold-archive-node\n")
    393    ;
    394    ;(printf "Root: \n") (pp (fold-archive-node archive '() (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
    395    ;(printf "Tag 'Test': \n") (pp (fold-archive-node archive (cons 'tag "Test") (lambda (name dirent acc) (cons (cons name dirent) acc))  '()))
    396    ;(printf "Root directory: \n") (pp (fold-archive-node archive dir-key (lambda (name dirent acc) (cons (cons name dirent) acc))  '()))
    397    
    398 |#
     448
     449   (test-group "Snapshots"
     450               (let* ((test-dir (string-append store-path "-test-data")))
     451                 (test-define-values "Store a directory" (dir-key dir-reused?)
     452                                     (call-with-context-support
     453                                      (archive-global-directory-rules a)
     454                                      (lambda ()
     455                                        (store-directory! a test-dir))))
     456
     457                 (if (archive-unlinkable? a)
     458                     (test-assert "Directory was not reused" (not dir-reused?)))
     459
     460                 (test-define-values "Tag it as a snapshot" (sk1)
     461                                     (tag-snapshot! a "Test" dir-key dir-reused? (list)))
     462
     463                 (test-define-values "Store the directory again" (dir2-key dir2-reused?)
     464                                     (call-with-context-support
     465                                      (archive-global-directory-rules a)
     466                                      (lambda ()
     467                                        (store-directory! a test-dir))))
     468
     469                 (test-assert "Directory was reused" dir2-reused?)
     470
     471                 (test-assert "Directory has the same key" (string=? dir-key dir2-key))
     472
     473                 (test-define-values "Tag it as a snapshot" (sk2)
     474                                     (tag-snapshot! a "Test" dir2-key dir2-reused? (list)))
     475
     476                 (test-define-values "Walk the history with fold-history" (result)
     477                                     (fold-history a (archive-tag a "Test")
     478                                                   (lambda (snapshot-key snapshot acc)
     479                                                     (cons snapshot acc))
     480                                                   '()))
     481                 (test-assert "History has expected form"
     482                              (match result
     483                                     (((('previous . sk1*)
     484                                        ('mtime . _)
     485                                        ('contents . dir2-key*))
     486                                       (('mtime . _)
     487                                        ('contents . dir-key*)))
     488                                      (and (string=? sk1 sk1*)
     489                                           (string=? dir2-key dir2-key*)
     490                                           (string=? dir-key dir-key*)))
     491                                     (else #f)))
     492
     493                 (test-define-values "Walk the tag list with fold-archive-node" (root)
     494                                     (fold-archive-node a '() (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     495                 (test-assert "Root history has expected form"
     496                              (match root
     497                                     (((('tag . "Test")
     498                                        "Test"
     499                                        'tag
     500                                        ('current . sk2*)))
     501                                      (string=? sk2 sk2*))
     502                                     (else #f)))
     503                 (test-define-values "Walk the history of tag 'Test' with fold-archive-node" (tag)
     504                                     (fold-archive-node a '(tag . "Test") (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     505                 (test-assert "Tag history has expected form"
     506                              (match tag
     507                                     (((dir-key-c*
     508                                        "current"
     509                                        'snapshot
     510                                        ('previous . sk1*)
     511                                        ('mtime . _)
     512                                        ('contents . dir-key*))
     513                                       (dir-key-c**
     514                                        _
     515                                        'snapshot
     516                                        ('previous . sk1**)
     517                                        ('mtime . _)
     518                                        ('contents . dir-key**))
     519                                       (dir-key-c***
     520                                        _
     521                                        'snapshot
     522                                        ('mtime . _)
     523                                        ('contents . dir-key***)))
     524                                      (and
     525                                       (string=? sk1 sk1*)
     526                                       (string=? dir-key dir-key-c*)
     527                                       (string=? dir-key dir-key*)
     528                                       (string=? sk1 sk1**)
     529                                       (string=? dir-key dir-key-c**)
     530                                       (string=? dir-key dir-key**)
     531                                       (string=? dir-key dir-key-c***)
     532                                       (string=? dir-key dir-key***)))
     533                                     (else #f)))
     534                 (test-define-values "Walk the root directory with fold-archive-node" (dir)
     535                                     (fold-archive-node a dir-key (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     536                 ; FIXME: Write a giant match to match this bad boy...
     537                 (pp dir)
     538                 (printf "sk1: ~a\n" sk1)
     539                 (printf "sk2: ~a\n" sk2)
     540                 (printf "dir-key: ~a\n" dir-key)
     541                 (printf "dir2-key: ~a\n" dir2-key)
     542
     543
     544))
    399545
    400546   "This archive seems to work!")
    401547
    402 
    403548;; Actual Tests
    404549
     550(if (directory? "./tmp")
     551    (delete-directory "./tmp" #t))
    405552(create-directory "./tmp")
    406553
     
    449596 (test "Close archive" (void) (archive-close! be)))
    450597
     598(printf "Final count of failures: ~a\n" (test-failure-count))
     599
    451600(test-exit)
Note: See TracChangeset for help on using the changeset viewer.