Changeset 22448 in project for release/4/ugarit/trunk


Ignore:
Timestamp:
01/17/11 02:55:48 (11 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Ongoing test development, and removed the version number

  • Salmonella seems to complain that we have version 0.7 declared, but we're building from trunk, so I commented out the version numbers. When the tests are complete, I'll tag it as v1.0 anyway.
  • sexpr stream tests are now complete
  • file store/restore tests are complete
  • directory operation tests are still to be ported
  • mtime caching tests are still to be written in the first place
Location:
release/4/ugarit/trunk
Files:
3 edited

Legend:

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

    r22446 r22448  
    237237                     (check-dir-is-empty store-path))))
    238238
    239 #|
    240 
    241    (printf "1-element sexpr stream...\n")
    242    (define test-list (list 1 2 3 4 5 6 7 8 9 10 11))
    243    (define test-data (list->u8vector test-list))
    244    (define test-key ((archive-hash a) test-data 'test))
    245    (define ssw (make-sexpr-stream-writer* a 't 'ti))
    246    (archive-put! a test-key test-data 'test)
    247    ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f)))
    248    (define-values (ss-hash ss-reused?) ((sexpr-stream-writer-finish! ssw)))
    249    (assert (not ss-reused?))
    250    (define sexprs (fold-sexpr-stream archive ss-hash 't 'ti cons '()))
    251    (assert (equal? sexprs `((foo ,test-key))))
     239   (test-group "2-element sexpr stream"
     240               (define test-list (list 1 2 3 4 5 6 7 8 9 10 11 12))
     241               (define test-data (list->u8vector test-list))
     242               (test-define "Archive hash" test-key ((archive-hash a) test-data 'test))
     243               (test "Archive write" (void) (archive-put! a test-key test-data 'test))
     244               (test-define "Create sexpr-stream writer" ssw (make-sexpr-stream-writer* a 't 'ti))
     245               (test "Write to sexpr stream" (void)
     246                     ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f))))
     247               (test "Write to sexpr stream" (void)
     248                     ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #t))))
     249               (test-define-values "Close sexpr-stream writer" (ss-hash ss-reused?) ((sexpr-stream-writer-finish! ssw)))
     250               (test-assert "Sexpr stream did not already exist" (not ss-reused?))
     251               (test "Sexpr stream reads back OK"
     252                     `((foo ,test-key) (foo ,test-key))
     253                     (fold-sexpr-stream a ss-hash 't 'ti cons '()))
     254
     255               (if (archive-unlinkable? a)
     256                   (begin
     257                     (define unlinks 0)
     258
     259                     (test "Unlink sexpr stream" (void)
     260                           (unlink-sexpr-stream! a ss-hash 't 'ti
     261                                                 (lambda (sexpr)
     262                                                   (test "Correct entry read back" `(foo ,test-key) (identity sexpr))
     263                                                   (test (sprintf "Unlink entry ~a" unlinks) (if (zero? unlinks) #f test-data) (archive-unlink! a test-key))
     264                                                   (set! unlinks (+ unlinks 1)))))
     265                     (test-assert "Sexpr stream is gone" (not (archive-exists? a ss-hash)))
     266                     (test-assert "Test block is gone" (not (archive-exists? a test-key)))
     267                     (check-dir-is-empty store-path))))
     268
     269   (test-group (sprintf "~A-element sexpr stream" iterations)
     270               (define test-list (list 1 2 3 4 5 6 7 8 9 10 11 12 13))
     271               (define test-data (list->u8vector test-list))
     272               (test-define "Archive hash" test-key ((archive-hash a) test-data 'test))
     273               (test "Archive write" (void) (archive-put! a test-key test-data 'test))
     274               (test-define "Create sexpr-stream writer" ssw (make-sexpr-stream-writer* a 't 'ti))
     275               ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f)))
     276               (dotimes (iter iterations)
     277                        (test "Write to sexpr stream" (void)
     278                     ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #t)))))
     279               (test-define-values "Close sexpr-stream writer" (ss-hash ss-reused?) ((sexpr-stream-writer-finish! ssw)))
     280               (test-assert "Sexpr stream did not already exist" (not ss-reused?))
     281               (test-define "Sexpr stream reads back OK" sexprs
     282                            (fold-sexpr-stream a ss-hash 't 'ti cons '()))
     283               (test "Correct number of sexprs read back" (+ 1 iterations) (length sexprs))
     284               (test-assert "Correct sexprs read back"
     285                            (every
     286                             (lambda (sexpr) (equal? sexpr `(foo ,test-key)))
     287                            sexprs))
     288
     289               (if (archive-unlinkable? a)
     290                   (begin
     291                     (define unlinks 0)
     292
     293                     (test "Unlink sexpr stream" (void)
     294                           (unlink-sexpr-stream! a ss-hash 't 'ti
     295                                                 (lambda (sexpr)
     296                                                   (test "Correct entry read back" `(foo ,test-key) (identity sexpr))
     297                                                   (test (sprintf "Unlink entry ~a" unlinks) (if (< unlinks iterations) #f test-data) (archive-unlink! a test-key))
     298                                                   (set! unlinks (+ unlinks 1)))))
     299                     (test-assert "Sexpr stream is gone" (not (archive-exists? a ss-hash)))
     300                     (test-assert "Test block is gone" (not (archive-exists? a test-key)))
     301                     (check-dir-is-empty store-path))))
     302
     303   (test-group "Files"
     304               (define test-string "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")
     305
     306   (test-define-values "Store a file" (file-key file-reused?)
     307                       (with-input-from-string test-string (lambda ()
     308                                                             (store-file! a "/test-file" (vector 0 0 0 0 0 0 0 0 0 0 0 0 0)))))
     309
     310
     311   (test "Read it back" test-string
     312         (with-output-to-string
     313           (lambda ()
     314             (write-file-contents a file-key))))
     315   
    252316   (if (archive-unlinkable? a)
    253317      (begin
    254          (unlink-sexpr-stream! archive ss-hash 't 'ti
    255             (lambda (sexpr)
    256                (assert (equal? sexpr `(foo ,test-key)))
    257                (archive-unlink! archive test-key)))
    258          (assert (not (archive-exists? archive ss-hash)))
    259          (assert (not (archive-exists? archive test-key)))
    260          (check-dir-is-empty store-path)))
    261 
    262    (printf "2-element sexpr stream...\n")
    263    (define test-list (list 1 2 3 4 5 6 7 8 9 10 11 12))
    264    (define test-data (list->u8vector test-list))
    265    (define test-key ((archive-hash a) test-data 'test))
    266    (define ssw (make-sexpr-stream-writer* a 't 'ti))
    267    (archive-put! a test-key test-data 'test)
    268    ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f)))
    269    ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f)))
    270    (define-values (ss-hash ss-reused?) ((sexpr-stream-writer-finish! ssw)))
    271    (assert (not ss-reused?))
    272    (define sexprs (fold-sexpr-stream archive ss-hash 't 'ti cons '()))
    273    (assert (equal? sexprs `((foo ,test-key) (foo ,test-key))))
    274 
    275    (if (archive-unlinkable? a)
    276       (begin
    277          (unlink-sexpr-stream! archive ss-hash 't 'ti
    278             (lambda (sexpr)
    279                (assert (equal? sexpr `(foo ,test-key)))
    280                (archive-unlink! archive test-key)))
    281          (assert (not (archive-exists? archive ss-hash)))
    282          (assert (not (archive-exists? archive test-key)))
    283          (check-dir-is-empty store-path)))
    284    
    285    (printf "~A-element sexpr stream...\n" iterations)
    286    (define test-list (list 1 2 3 4 5 6 7 8 9 10 11 12 13))
    287    (define test-data (list->u8vector test-list))
    288    (define test-key ((archive-hash a) test-data 'test))
    289    (define ssw (make-sexpr-stream-writer* a 't 'ti))
    290    (archive-put! a test-key test-data 'test)
    291    (dotimes (iter iterations)
    292       ((sexpr-stream-writer-write! ssw) `(foo ,test-key) (list (cons test-key #f))))
    293    (define-values (ss-hash ss-reused?) ((sexpr-stream-writer-finish! ssw)))
    294    (assert (not ss-reused?))
    295    (define sexprs (fold-sexpr-stream archive ss-hash 't 'ti cons '()))
    296    (assert (= (length sexprs) iterations))
    297    (assert (every
    298       (lambda (sexpr) (equal? sexpr `(foo ,test-key)))
    299       sexprs))
    300 
    301    ;(sexpr-stream-cat a ss-hash 't 'ti 0)
    302 
    303    (if (archive-unlinkable? a)
    304       (begin
    305          (unlink-sexpr-stream! archive ss-hash 't 'ti
    306             (lambda (sexpr)
    307                (assert (equal? sexpr `(foo ,test-key)))
    308                (archive-unlink! archive test-key)))
    309    
    310          (assert (not (archive-exists? archive test-key)))
    311          (check-dir-is-empty store-path)))
    312    
    313    (printf "files...\n")
    314    (define test-string "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")
    315    
    316    (printf "\tStore a file\n")
    317    (define-values (file-key file-reused?)
    318       (with-input-from-string test-string (lambda ()
    319          (store-file! archive))))
    320 
    321    (printf "\tRead it back\n")
    322    (define result (with-output-to-string
    323       (lambda ()
    324          (write-file-contents archive file-key))))
    325    
    326    (assert (string=? test-string result))
    327    
    328    (if (archive-unlinkable? a)
    329       (begin
    330          (printf "\tDelete the file\n")
    331          (unlink-file! archive file-key)
    332          (check-dir-is-empty store-path)))
     318         (test "Delete the file" (void) (unlink-file! archive file-key))
     319         (check-dir-is-empty store-path))))
     320#|
     321   
    333322   
    334323   (printf "directories...\n")
  • release/4/ugarit/trunk/ugarit-core.scm

    r22219 r22448  
    4242
    4343         store-file!
     44         write-file-contents
    4445         store-directory!
    4546         unlink-directory!
  • release/4/ugarit/trunk/ugarit.setup

    r20740 r22448  
    44
    55(install-extension 'directory-rules '("directory-rules.so" "directory-rules.o" "directory-rules.import.so")
    6   '((version 0.7)
     6  '( ;(version 0.7)
    77    (static "directory-rules.o")))
    88
     
    1212
    1313(install-extension 'ugarit-backend '("ugarit-backend.so" "ugarit-backend.o" "ugarit-backend.import.so")
    14   '((version 0.7)
     14  '( ;(version 0.7)
    1515    (static "ugarit-backend.o")))
    1616
     
    2020
    2121(install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o" "ugarit-core.import.so")
    22   '((version 0.7)
     22  '( ;(version 0.7)
    2323    (static "ugarit-core.o")))
    2424
    2525(compile backend-fs.scm)
    2626(install-program 'backend-fs "backend-fs"
    27   '((version 0.7)))
     27  '( ;(version 0.7)
     28    ))
    2829
    2930(compile ugarit.scm)
    3031(install-program 'ugarit "ugarit"
    31   '((version 0.7)))
     32  '( ;(version 0.7)
     33  ))
Note: See TracChangeset for help on using the changeset viewer.