Changeset 15593 in project


Ignore:
Timestamp:
08/28/09 06:39:58 (10 years ago)
Author:
kon
Message:

Dropped use of "ports".

Location:
release/4/message-digest/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/message-digest/trunk/message-digest.scm

    r15592 r15593  
    44;; Issues
    55;;
    6 ;; - Renames the bindings of R5RS & SRFI-13 string procedures so byte-oriented!
    7 ;;
    8 ;; - The ->fixnum/blob/... is approximate at best!
    9 
     6;; - Renames the bindings of some string procedures to emphasize byte orientation.
     7;; This is a real kludge.
    108
    119(module message-digest
    1210        (export
    13           ;; Aux
     11          ; Aux
    1412                byte-string->substring-list/shared
    1513                byte-string->substring-list
    1614                byte-string->hexadecimal
    17                 ;; Params
    18                 message-digest-chunk-size message-digest-chunk-reader message-digest-chunk-converter
    19                 ;; Perf
     15                ; Params
     16                message-digest-chunk-size
     17                message-digest-chunk-reader
     18                message-digest-chunk-converter
     19                ;
    2020                make-binary-message-digest
    2121                make-message-digest
    22                 ;; Type
     22                ;
    2323                make-message-digest-primitive
    2424                message-digest-primitive?
     
    3131                message-digest-primitive-apply)
    3232
    33 (import (rename scheme (string-length byte-string-length) (string-copy byte-string-copy) (list->string list->byte-string) (make-string make-byte-string))
     33(import (rename scheme (string-length byte-string-length)
     34                       (list->string list->byte-string)
     35                       (make-string make-byte-string))
     36        (except scheme string->list string-copy)
    3437        (rename chicken (string->blob byte-string->blob))
    35         (only ports with-output-to-string)
    36         (only data-structures ->string)
    37         (rename data-structures (->string ->byte-string))
    3838        (only lolevel allocate free)
    3939        (only srfi-1 map! reverse!)
    4040        srfi-4
    41         (only srfi-13 substring/shared string-for-each)
    42         (rename srfi-13 (substring/shared byte-substring/shared) (string-for-each byte-string-for-each))
     41        (only srfi-13 substring/shared string-for-each string->list string-copy string-concatenate)
     42        (rename srfi-13 (substring/shared byte-substring/shared)
     43                        (string-for-each byte-string-for-each)
     44                        (string->list byte-string->list)
     45                        (string-copy byte-string-copy))
    4346        (only srfi-69 hash)
    4447        miscmacros
    45         type-checks type-errors)
    46 (require-library ports data-structures lolevel srfi-1 srfi-4 srfi-13 srfi-69
     48        type-checks
     49        type-errors)
     50
     51(require-library lolevel srfi-1 srfi-4 srfi-13 srfi-69
    4752                 miscmacros type-checks type-errors)
    4853
     
    8590  (map! byte-string-copy (byte-string->substring-list/shared str chunk-size start end)) )
    8691
    87 (define-inline (int->hex ch)
    88   (let* ((int (char->integer ch))
    89          (str (number->string int 16)))
    90     (if (< int 16) (string-append "0" str) str) ) )
    91 
    9292(define (byte-string->hexadecimal str #!optional (start 0) (end (byte-string-length str)))
    93   (with-output-to-string (lambda () (byte-string-for-each (lambda (x) (display (int->hex x))) str start end) ) ) )
     93  (define (byte-char->hex ch)
     94    (let* ((int (char->integer ch))
     95           (str (number->string int 16)))
     96      (if (< int 16) (string-append "0" str) str) ) )
     97  (string-concatenate (map! byte-char->hex (byte-string->list str start end))) )
    9498
    9599;;;
     
    148152(define (%make-binary-message-digest src ctx-info digest-len init updt fin id)
    149153  (letrec ((ctx #f)
    150            (update-with (lambda (proc) (while* (proc) (update ctx it (byte-object-size it))))) )
     154           (update-while (lambda (proc) (while* (proc) (updt ctx it (byte-object-size it))))) )
    151155    (dynamic-wind
    152156      (lambda ()
     
    159163               (updt ctx src (blob-size src)) )
    160164              ((input-port? src)
    161                (%update-with ((message-digest-chunk-reader) src)) )
     165               (update-while ((message-digest-chunk-reader) src)) )
    162166              ((procedure? src)
    163                (%update-with src) )
     167               (update-while src) )
    164168              (((message-digest-chunk-converter) src)
    165169               => (lambda (buf) (updt ctx buf (byte-object-size buf))) )
  • release/4/message-digest/trunk/tests/run.scm

    r15592 r15593  
    11;;;; message-digest-test.scm
     2
     3
     4;; Issues
     5;;
     6;; - Needs many more tests, especially the entire input-port & procedure source stuff.
    27
    38(use test)
     
    3439    (test-assert (pointer? ctx))
    3540    (test-assert (string? result))
    36     (move-memory! ctx bytes result digest-length) )
     41    (move-memory! ctx result digest-length) )
    3742
    3843  (let ((mdp (make-message-digest-primitive chunk-size digest-length init update final 'foo)))
     
    4752      (test 'foo (message-digest-primitive-name mdp))
    4853
    49       (test "6162206364" (byte-string->hexadecimal (message-digest-primitive-apply mdp "ab cd"))) )
     54      (let ((res (message-digest-primitive-apply mdp "ab cd")))
     55        (test "6162206364" (byte-string->hexadecimal res)) ) )
    5056)
Note: See TracChangeset for help on using the changeset viewer.