Changeset 40434 in project


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

string index is char index issue, add optional argument types, string update is direct (remove blob conversion (?)), blob slice is primitive, add blob/string tests, new test runner

Location:
release/5/message-digest-utils/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/5/message-digest-utils/trunk/message-digest-byte-vector.scm

    r38970 r40434  
    55;;;; Kon Lovett, May '10 (message-digest.scm)
    66;;;; Kon Lovett, Jan '06 (message-digest.scm)
     7
     8;; Issues
     9;;
     10;; - blob has byte index but string has character index!
    711
    812(module message-digest-byte-vector
     
    3337(include "message-digest.types")
    3438
    35 (: message-digest-update-blob (message-digest blob #!rest -> void))
    36 (: message-digest-update-string (message-digest string #!rest -> void))
     39(: message-digest-update-blob (message-digest blob #!optional fixnum fixnum -> void))
     40(: message-digest-update-string (message-digest string #!optional fixnum fixnum -> void))
     41(: message-digest-blob (message-digest-primitive blob #!optional message-digest-result-type fixnum fixnum -> message-digest-result-type))
     42(: message-digest-string (message-digest-primitive string #!optional message-digest-result-type fixnum fixnum -> message-digest-result-type))
     43(: message-digest-blob! (message-digest-primitive blob message-digest-buffer #!optional message-digest-result-type fixnum fixnum -> message-digest-result-type))
     44(: message-digest-string! (message-digest-primitive string message-digest-buffer #!optional message-digest-result-type fixnum fixnum -> message-digest-result-type))
     45;
    3746
    3847;;
     
    7887;; Single Source API
    7988
    80 (: message-digest-blob (message-digest-primitive blob #!rest -> message-digest-result-type))
    81 ;
    8289(define (message-digest-blob mdp blb . opts)
    8390  (let-optionals* opts (
     
    9198      (finalize-message-digest md restyp) ) ) )
    9299
    93 (: message-digest-string (message-digest-primitive string #!rest -> message-digest-result-type))
    94 ;
    95100(define (message-digest-string mdp str . opts)
    96101  (let-optionals* opts (
     
    104109      (finalize-message-digest md restyp) ) ) )
    105110
    106 (: message-digest-blob! (message-digest-primitive blob message-digest-buffer #!rest -> message-digest-result-type))
    107 ;
    108111(define (message-digest-blob! mdp blb buf . opts)
    109112  (let-optionals* opts (
     
    116119      (finalize-message-digest! md buf) ) ) )
    117120
    118 (: message-digest-string! (message-digest-primitive string message-digest-buffer #!rest -> message-digest-result-type))
    119 ;
    120121(define (message-digest-string! mdp str buf . opts)
    121122  (let-optionals* opts (
  • release/5/message-digest-utils/trunk/message-digest-support.scm

    r38970 r40434  
    77
    88;; Issues
     9;;
     10;; - blob has byte index but string has character index!
    911;;
    1012;; - Uses 'context-info' to determine whether active context is "own" allocation or
     
    2931(import (chicken type))
    3032(import (only (chicken memory representation) number-of-bytes))
     33(import (only (chicken memory) move-memory!))
    3134(import (only srfi-4
    3235  s8vector? u8vector? subu8vector u8vector-length
     
    5659(: blob/slice (blob start-index end-index --> blob))
    5760(: string/slice (string start-index end-index --> string))
    58 (: *message-digest-update-blob (message-digest blob #!rest -> void))
    59 (: *message-digest-update-string (message-digest string -> void))
     61
    6062(: message-digest-algorithm-update (message-digest -> procedure))
     63
     64(: *message-digest-update-blob (message-digest blob #!optional fixnum -> void))
     65(: *message-digest-update-string (message-digest string #!optional fixnum -> void))
    6166
    6267;;
     
    8186;;
    8287
     88(define (subblob blb start end)
     89  (let* (
     90    (siz (- end start))
     91    (buf (make-blob siz)) )
     92    (move-memory! blb buf siz start 0)
     93    buf ) )
     94
     95(define string-size number-of-bytes)
     96
     97;;
     98
    8399(define (u8vector/slice u8vec start end)
    84100   (let (
     
    88104      (subu8vector u8vec start end) ) ) )
    89105
    90 (define blob/slice
    91   ;need byte-oriented semantics
    92   (let ((substring substring))
    93     (lambda (blb start end)
    94       (let (
    95         (end (or end (blob-size blb))) )
    96         (if (and (= end (blob-size blb)) (zero? start))
    97           blb
    98           (string->blob (substring (blob->string blb) start end)) ) ) ) ) )
     106(define (blob/slice blb start end)
     107  (let (
     108    (end (or end (blob-size blb))) )
     109    (if (and (= end (blob-size blb)) (zero? start))
     110      blb
     111      (subblob blb start end)) ) )
    99112
    100113(define (string/slice str start end)
     
    107120;;
    108121
     122(define (message-digest-algorithm-update md)
     123  (message-digest-primitive-update (message-digest-algorithm md)) )
     124
     125;;
     126
    109127(define (*message-digest-update-blob md blb . opts)
    110128  (let (
     
    112130    ((message-digest-algorithm-update md) (message-digest-context md) blb siz) ) )
    113131
    114 (define (*message-digest-update-string md str)
    115         (*message-digest-update-blob md (string->blob str)) )
    116 
    117 (define (message-digest-algorithm-update md)
    118   (message-digest-primitive-update (message-digest-algorithm md)) )
     132(define (*message-digest-update-string md str . opts)
     133        (let (
     134    (siz (optional opts (string-size str))) )
     135    ((message-digest-algorithm-update md) (message-digest-context md) str siz) ) )
    119136
    120137) ;module message-digest-support
  • release/5/message-digest-utils/trunk/message-digest-utils.egg

    r39910 r40434  
    33
    44((synopsis "Message Digest Support")
    5  (version "4.2.5")
     5 (version "4.2.6")
    66 (category crypt)
    77 (author "Kon Lovett")
  • release/5/message-digest-utils/trunk/tests/message-digest-utils-test.scm

    r38972 r40434  
    2828(import message-digest-update-item)
    2929(import message-digest-item)
     30(import message-digest-byte-vector)
    3031
    3132;;
     
    109110  (define mdp (make-message-digest-primitive make-context DIGEST-LENGTH init update final))
    110111
     112  (test-group "string Source"
     113    (let (
     114      (md (initialize-message-digest mdp)) )
     115      (test-assert (message-digest-update-string md (string #\1 #\2 #\3 #\4 #\5)))
     116      (test "3132333435" (finalize-message-digest md)) )
     117  )
     118
     119  (test-group "blob Source"
     120    (let (
     121      (md (initialize-message-digest mdp)) )
     122      (test-assert (message-digest-update-blob md #${3132333435}))
     123      (test "3132333435" (finalize-message-digest md)) )
     124  )
     125
    111126  (test-group "u8vector Source"
    112127    (let (
  • release/5/message-digest-utils/trunk/tests/run.scm

    r39805 r40434  
    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.