Changeset 40442 in project


Ignore:
Timestamp:
09/08/21 00:52:06 (2 weeks ago)
Author:
Kon Lovett
Message:

fix make-message-digest-primitive update procedure type, new test runner

Location:
release/5/message-digest-primitive/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/message-digest-primitive/trunk/message-digest-primitive.egg

    r39908 r40442  
    44
    55((synopsis "Message Digest Primitive")
    6  (version "4.3.3")
     6 (version "4.3.4")
    77 (category crypt)
    88 (author "Kon Lovett")
  • release/5/message-digest-primitive/trunk/message-digest-primitive.scm

    r38986 r40442  
    5555(define-type context-info (or fixnum procedure))
    5656
    57 (define-type raw-update-value (or boolean update-procedure))
     57(define-type updater-value (or boolean update-procedure))
     58
     59(: *make-message-digest-primitive (context-info fixnum init-procedure update-procedure final-procedure fixnum primitive-name updater-value -> message-digest-primitive))
     60(: message-digest-primitive? (* -> boolean : message-digest-primitive))
     61(: message-digest-primitive-context-info (message-digest-primitive --> context-info))
     62(: message-digest-primitive-digest-length (message-digest-primitive --> fixnum))
     63(: message-digest-primitive-init (message-digest-primitive --> init-procedure))
     64(: message-digest-primitive-update (message-digest-primitive --> update-procedure))
     65(: message-digest-primitive-final (message-digest-primitive --> final-procedure))
     66(: message-digest-primitive-block-length (message-digest-primitive --> fixnum))
     67(: message-digest-primitive-name (message-digest-primitive --> primitive-name))
     68(: message-digest-primitive-raw-update (message-digest-primitive --> updater-value))
     69
     70(: scheme-object-data-pointer ((not immediate) -> pointer))
     71(: make-scheme-object-updater (update-procedure -> update-procedure))
     72(: make-message-digest-primitive (context-info fixnum init-procedure updater-value final-procedure #!rest -> message-digest-primitive))
     73(: make-message-digest-primitive-context (message-digest-primitive -> message-digest-primitive-context))
    5874
    5975;;
     
    7793;fixnum procedure procedure procedure fixnum (or symbol string) (or boolean
    7894;procedure)) (struct message-digest-primitive))'
    79 (: *make-message-digest-primitive (context-info fixnum init-procedure update-procedure final-procedure fixnum primitive-name raw-update-value -> message-digest-primitive))
    80 (: message-digest-primitive? (* -> boolean : message-digest-primitive))
    81 (: message-digest-primitive-context-info (message-digest-primitive --> context-info))
    82 (: message-digest-primitive-digest-length (message-digest-primitive --> fixnum))
    83 (: message-digest-primitive-init (message-digest-primitive --> init-procedure))
    84 (: message-digest-primitive-update (message-digest-primitive --> update-procedure))
    85 (: message-digest-primitive-final (message-digest-primitive --> final-procedure))
    86 (: message-digest-primitive-block-length (message-digest-primitive --> fixnum))
    87 (: message-digest-primitive-name (message-digest-primitive --> primitive-name))
    88 (: message-digest-primitive-raw-update (message-digest-primitive --> raw-update-value))
    89 ;
    9095(define-record-type message-digest-primitive
    9196  (*make-message-digest-primitive ctxi digest-len init update final block-len name raw-update)
     
    120125;;
    121126
    122 (: scheme-object-data-pointer ((not immediate) -> pointer))
    123 ;
    124127(define scheme-object-data-pointer
    125128  (foreign-lambda* c-pointer ((scheme-pointer psrc)) "return( psrc );"))
     
    127130;;
    128131
    129 (: make-scheme-object-updater (update-procedure -> update-procedure))
    130 ;
    131132(define ((make-scheme-object-updater raw-update) ctx-info obj len)
    132133  (raw-update ctx-info (scheme-object-data-pointer obj) len) )
     
    135136
    136137;assignment of value of type `(procedure message-digest-primitive#make-message-digest-primitive (* * * * * #!rest) (struct message-digest-primitive#message-digest-primitive))' to toplevel variable `message-digest-primitive#make-message-digest-primitive' does not match declared type `(procedure message-digest-primitive#make-message-digest-primitive ((or fixnum procedure) fixnum procedure procedure procedure #!rest *) (struct message-digest-primitive))'
    137 (: make-message-digest-primitive (context-info fixnum init-procedure (or boolean update-procedure) final-procedure #!rest -> message-digest-primitive))
    138138;
    139139(define (make-message-digest-primitive ctx-info digest-len init update final
     
    151151;;
    152152
    153 (: make-message-digest-primitive-context (message-digest-primitive -> message-digest-primitive-context))
    154 ;
    155153(define (make-message-digest-primitive-context mdp)
    156154  (let (
  • release/5/message-digest-primitive/trunk/tests/run.scm

    r39803 r40442  
    77    make-pathname pathname-file pathname-replace-directory pathname-strip-extension)
    88  (only (chicken process) system)
    9   (only (chicken process-context) command-line-arguments)
     9  (only (chicken process-context) command-line-arguments get-environment-variable)
    1010  (only (chicken format) format)
    1111  (only (chicken file) file-exists? find-files)
     
    1313
    1414;; Globals
     15
     16(define *csi* (or (get-environment-variable "CHICKEN_CSI") "csi"))
     17(define *csc* (or (get-environment-variable "CHICKEN_CSC") "csc"))
    1518
    1619(define *csc-init-options* '(
     
    7982
    8083(define (run-test-evaluated source)
    81   (format #t "*** csi ~A ***~%" (pathname-file source))
    82   (system-must (string-append "csi -s " source)) )
     84  (format #t "*** ~A ~A ***~%" *csi* (pathname-file source))
     85  (system-must (string-append *csi* " -s " source)) )
    8386
    8487(define (run-test-compiled source csc-options)
    8588  (let ((optstr (apply string-append (intersperse csc-options " "))))
    86     (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     89    (format #t "*** ~A ~A ~A ***~%" *csc* (pathname-file source) optstr)
    8790    ;csc output is in current directory
    88     (system-must (string-append "csc" " " optstr " " source)) )
     91    (system-must (string-append *csc* " " optstr " " source)) )
    8992  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    9093
Note: See TracChangeset for help on using the changeset viewer.