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/ugarit-core.scm

    r22448 r25477  
    1717         archive-unlock-tag!
    1818         archive-tag-locked?
     19         archive-link!
    1920         archive-unlink!
    2021         archive-close!
     
    4344         store-file!
    4445         write-file-contents
     46         unlink-file!
     47         
    4548         store-directory!
    4649         unlink-directory!
     
    5760(use autoload)
    5861
    59 (autoload lzma (compress lzma:compress) (decompress lzma:decompress))
    60 (autoload z3 z3:encode-buffer z3:decode-buffer)
     62(define ((deny-autoload module)) (error (sprintf "Autoload does not seem to be working, so optional components from module ~s are not working" module) module))
     63
     64(define-syntax no-autoload
     65  (er-macro-transformer
     66   (lambda (expr rename compare)
     67     (let ((module (cadr expr))
     68           (procs (cddr expr))
     69           (_begin (rename 'begin))
     70           (_define (rename 'define))
     71           (_deny-autoload (rename 'deny-autoload)))
     72           (cons _begin
     73                 (map (lambda (x)
     74                        (let ((orig-binding (if (pair? x) (car x) x))
     75                              (new-binding (if (pair? x) (cadr x) x)))
     76                          `(,_define ,new-binding (,_deny-autoload ',module))))
     77                      procs))))))
     78
     79(no-autoload lzma (compress lzma:compress) (decompress lzma:decompress))
     80(no-autoload z3 z3:encode-buffer z3:decode-buffer)
    6181(autoload tiger-hash tiger192-digest tiger192-binary-digest)
    62 (autoload sha2 sha256-digest sha384-digest sha512-digest sha512-binary-digest)
    63 (autoload aes make-aes128-encryptor make-aes128-decryptor make-aes192-encryptor make-aes192-decryptor make-aes256-encryptor make-aes256-decryptor)
     82(no-autoload sha2 sha256-digest sha384-digest sha512-digest sha512-binary-digest)
     83(no-autoload aes make-aes128-encryptor make-aes128-decryptor make-aes192-encryptor make-aes192-decryptor make-aes256-encryptor make-aes256-decryptor)
    6484
    6585(use srfi-1)
     
    176196                                        ; Generate initial IV from the key and current time
    177197            (move-memory! (string->blob (tiger192-binary-digest
    178                                          (string-append (blob->string key) (number->string (time->seconds (current-time)))))) iv 16)
     198                                         (string-append (blob->string key) (number->string (current-seconds))))) iv 16)
    179199
    180200            (let-values (((encryptor decryptor)
     
    716736      (unlink-sexpr-stream-block! archive key sexpr-unlink!))
    717737     (else
    718       (assert (or (eq? type leaf-type) (eq? type ks-type)))))))
     738      (assert (or (eq? type leaf-type) (eq? type ks-type)) (sprintf "unlink-sexpr-stream!: Invalid block type (expected ~a)" (list leaf-type ks-type)) type)))))
    719739
    720740;; DIRECTORY STORAGE
     
    859879    (if (or mtime atime)
    860880        (change-file-times path
    861                            (if atime (cdr atime) (time->seconds (current-time)))
    862                            (if mtime (cdr mtime) (time->seconds (current-time)))))
     881                           (if atime (cdr atime) (current-seconds))
     882                           (if mtime (cdr mtime) (current-seconds))))
    863883
    864884    (void)))
     
    9941014         (append
    9951015          (list
    996            (cons 'mtime (time->seconds (current-time)))
     1016           (cons 'mtime (current-seconds))
    9971017           (cons 'contents contents-key))
    9981018          snapshot-properties))
Note: See TracChangeset for help on using the changeset viewer.