Changeset 34426 in project


Ignore:
Timestamp:
08/27/17 21:43:08 (3 months ago)
Author:
kon
Message:

add range

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

Legend:

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

    r34302 r34426  
    1313  message-digest-update-blob
    1414  message-digest-update-string
    15   message-digest-update-substring  ;DEPRECATED
    1615  message-digest-blob
    17   message-digest-string)
     16  message-digest-string
     17  message-digest-blob!
     18  message-digest-string!
     19  ;DEPRECATED
     20  message-digest-update-substring)
    1821
    1922(import scheme)
     
    2730(import
    2831  (only type-checks
    29     check-blob check-string))
     32    check-blob check-string check-natural-fixnum check-range))
    3033(require-library
    3134  type-checks)
     
    3639  message-digest-support)
    3740
     41(declare (bound-to-procedure ##sys#substring))
     42
    3843;;; Message Digest API
    3944
     
    4247;;
    4348
    44 (define (message-digest-update-blob md blb)
     49(define (message-digest-update-blob md blb #!optional (start 0) (end (blob-size blb)))
    4550  (*message-digest-update-blob
    4651    (check-message-digest 'message-digest-update-blob md)
    47     (check-blob 'message-digest-update-blob blb)) )
     52    (check-blob/slice 'message-digest-update-blob blb start end)) )
    4853
    4954;;
    5055
    51 (define (message-digest-update-string md str)
     56(define (message-digest-update-string md str #!optional (start 0) (end (string-length str)))
    5257  (*message-digest-update-string
    5358    (check-message-digest 'message-digest-update-string md)
    54     (check-string 'message-digest-update-string str)) )
     59    (check-string/slice 'message-digest-update-string str start end)) )
    5560
    5661;;
     
    6469;; Single Source API
    6570
    66 (define (message-digest-string mdp str #!optional (result-type (message-digest-result-form)))
     71(define (message-digest-blob mdp blb
     72            #!optional
     73            (result-type (message-digest-result-form))
     74            (start 0) (end (blob-size blb)))
    6775  (let ((md (initialize-message-digest mdp)))
    68     (message-digest-update-string md str)
     76    (message-digest-update-blob md blb start end)
    6977    (finalize-message-digest md result-type) ) )
    7078
    71 (define (message-digest-blob mdp blb #!optional (result-type (message-digest-result-form)))
     79(define (message-digest-string mdp str
     80            #!optional
     81            (result-type (message-digest-result-form))
     82            (start 0) (end (string-length str)))
    7283  (let ((md (initialize-message-digest mdp)))
    73     (message-digest-update-blob md blb)
     84    (message-digest-update-string md str start end)
    7485    (finalize-message-digest md result-type) ) )
    7586
     87(define (message-digest-blob! mdp blb result-buffer
     88            #!optional
     89            (start 0) (end (blob-size blb)))
     90  (let ((md (initialize-message-digest mdp)))
     91    (message-digest-update-blob md blb start end)
     92    (finalize-message-digest! md result-buffer) ) )
     93
     94(define (message-digest-string! mdp str result-buffer
     95            #!optional
     96            (start 0) (end (string-length str)))
     97  (let ((md (initialize-message-digest mdp)))
     98    (message-digest-update-string md str start end)
     99    (finalize-message-digest! md result-buffer) ) )
     100
     101;;;
     102
     103(define (check-blob/slice loc blb start end)
     104  (check-blob loc blb)
     105  (check-fixnum-range loc start end)
     106  (blob/slice blb start end) )
     107
     108(define (check-string/slice loc str start end)
     109  (check-string loc str)
     110  (check-fixnum-range loc start end)
     111  (string/slice str start end) )
     112
     113(define (check-fixnum-range loc start end)
     114  (check-range loc
     115    (check-natural-fixnum loc start 'start)
     116    (check-natural-fixnum loc end 'end)
     117    "end < start") )
     118
    76119) ;module message-digest-bv
  • release/4/message-digest/trunk/message-digest-chunk.scm

    r34375 r34426  
    1414  ;chunk
    1515  message-digest-raw-chunk?
    16   message-digest-raw-chunk-object message-digest-raw-chunk-size
     16  message-digest-raw-chunk-object
     17  message-digest-raw-chunk-size message-digest-raw-chunk-start
    1718  ;
    1819  message-digest-chunk-size
     
    5657
    5758(define-record-type message-digest-raw-chunk
    58   (make-message-digest-raw-chunk obj siz)
     59  (make-message-digest-raw-chunk obj siz beg)
    5960  message-digest-raw-chunk?
    6061  (obj message-digest-raw-chunk-object)
    61   (siz message-digest-raw-chunk-size) )
     62  (siz message-digest-raw-chunk-size)
     63  (beg message-digest-raw-chunk-start) )
    6264
    6365(define (default-chunk-fileno-read-maker fd #!optional (size (file-size fd)))
     
    6769    (let-values (((buffer cleanup)
    6870                  (mapped-buffer 'default-chunk-fileno-read-maker fd size)))
    69       (let ((chunk (make-message-digest-raw-chunk buffer size)))
     71      (let ((chunk (make-message-digest-raw-chunk buffer size 0)))
    7072        (lambda ()
    7173          (if buffer
  • release/4/message-digest/trunk/message-digest-item.scm

    r34302 r34426  
    2424;;; Single Source API
    2525
    26 (define (message-digest-object mdp obj #!optional (result-type (message-digest-result-form)))
     26(define (message-digest-object mdp obj #!optional (result-type (message-digest-result-form)) (start 0) (end #f))
    2727  (let ((md (initialize-message-digest mdp)))
    28     (message-digest-update-object md obj)
     28    (message-digest-update-object md obj start end)
    2929    (finalize-message-digest md result-type) ) )
    3030
  • release/4/message-digest/trunk/message-digest-srfi-4.scm

    r34302 r34426  
    1212
    1313(;export
    14   message-digest-update-bytevector                      ;DEPRECATED
    1514  message-digest-update-u8vector
    16   message-digest-update-subu8vector                     ;DEPRECATED
    17   message-digest-update-packed-vector           ;DEPRECATED
    18   message-digest-u8vector)
     15  message-digest-update-packed-vector
     16  message-digest-u8vector message-digest-u8vector!
     17  ;DEPRECATED
     18  message-digest-update-bytevector
     19  message-digest-update-subu8vector
     20  )
    1921
    2022(import scheme)
     
    5860;;
    5961
    60 (define (message-digest-update-u8vector md u8vec)
    61   (message-digest-update-blob md (u8vector->blob/shared u8vec)) )
     62(define (message-digest-update-u8vector md u8vec
     63            #!optional
     64            (start 0) (end (u8vector-length u8vec)))
     65  (message-digest-update-blob md
     66    (u8vector->blob/shared (u8vector/slice u8vec start end))) )
     67
     68;;; Single Source API
     69
     70(define (message-digest-u8vector mdp u8vec
     71            #!optional
     72            (result-type (message-digest-result-form))
     73            (start 0) (end (u8vector-length u8vec)))
     74  (let ((md (initialize-message-digest mdp)))
     75    (message-digest-update-u8vector md u8vec start end)
     76    (finalize-message-digest md result-type) ) )
     77
     78(define (message-digest-u8vector! mdp u8vec buffer
     79            #!optional
     80            (start 0) (end (u8vector-length u8vec)))
     81  (let ((md (initialize-message-digest mdp)))
     82    (message-digest-update-u8vector md u8vec start end)
     83    (finalize-message-digest! md buffer) ) )
     84
     85;;;
    6286
    6387;;
     
    88112        len) ) )
    89113
    90 ;;; Single Source API
    91 
    92 (define (message-digest-u8vector mdp u8vec #!optional (result-type (message-digest-result-form)))
    93   (let ((md (initialize-message-digest mdp)))
    94     (message-digest-update-u8vector md u8vec)
    95     (finalize-message-digest md result-type) ) )
    96 
    97114) ;module message-digest-srfi-4
  • release/4/message-digest/trunk/message-digest-support.scm

    r34300 r34426  
    1717  ; Support
    1818  packed-vector->blob/shared
     19  ;
     20  u8vector/slice blob/slice string/slice
     21  ;
    1922  *message-digest-update-blob
    2023  *message-digest-update-string)
     
    4548    #;u64vector->blob/shared
    4649    f32vector->blob/shared
    47     f64vector->blob/shared))
     50    f64vector->blob/shared
     51    subu8vector u8vector-length))
    4852(require-library
    4953  lolevel
     
    5256(require-extension
    5357  message-digest-primitive
    54   message-digest-type)
     58  message-digest-type
     59  fx-utils)
    5560
    5661;;; Support
     
    7580;;
    7681
     82(define (u8vector/slice u8vec start end)
     83   (let ((end (or end (u8vector-length u8vec))))
     84    (if (and (fxzero? start) (fx= end (u8vector-length u8vec)))
     85      u8vec
     86      (subu8vector u8vec start end) ) ) )
     87
     88(define (blob/slice blb start end)
     89  (let ((end (or end (blob-size blb))))
     90    (if (and (fxzero? start) (fx= end (blob-size blb)))
     91      blb
     92      (string->blob (##sys#substring (blob->string blb) start end)) ) ) )
     93
     94(define (string/slice str start end)
     95  (let ((end (or end (string-length str))))
     96    (if (and (fxzero? start) (fx= end (string-length str)))
     97      str
     98      (##sys#substring str start end) ) ) )
     99
     100;;
     101
    77102(define (*message-digest-update-blob md blb #!optional (siz (blob-size blb)))
    78103  ((message-digest-algorithm-update md)
  • release/4/message-digest/trunk/message-digest-update-item.scm

    r34397 r34426  
    6868;;
    6969
    70 (define (do-object-update loc md src)
     70(define (do-object-update loc md src start end)
    7171  (cond
    72     ((input-port? src)    (do-port-update loc md src) )
    73     ((procedure? src)     (do-procedure-update loc md src) )
    74     (else                 (do-bytes-update loc md src) ) ) )
    75 
    76 (define (do-port-update loc md in)
    77   (do-procedure-update loc md (get-port-chunk-reader in)) )
    78 
    79 (define (do-bytes-update loc md src)
     72    ((input-port? src)    (do-port-update loc md src start end) )
     73    ((procedure? src)     (do-procedure-update loc md src start end) )
     74    (else                 (do-bytes-update loc md src start end) ) ) )
     75
     76(define (do-port-update loc md in start end)
     77  (do-procedure-update loc md (get-port-chunk-reader in) start end) )
     78
     79(define (do-bytes-update loc md src start end)
    8080  (do-byte-source-update
    8181    loc
     
    8383    src
    8484    (get-update md)
    85     (get-raw-update md)) )
    86 
    87 (define (do-procedure-update loc md proc)
     85    (get-raw-update md)
     86    start end) )
     87
     88(define (do-procedure-update loc md proc start end)
    8889  (let ((s-updt (get-update md))
    8990        (r-updt (get-raw-update md))
     
    9192    ;note the 'src' object (return of proc) may or may not be unique
    9293    (while* (proc)
    93       (do-byte-source-update loc ctx it s-updt r-updt) ) ) )
    94 
    95 (define (do-byte-source-update loc ctx src s-updt r-updt)
     94      (do-byte-source-update loc ctx it s-updt r-updt start end) ) ) )
     95
     96(define (do-byte-source-update loc ctx src s-updt r-updt start end)
    9697  (cond
    9798    ; simple bytes
    9899    ((blob? src)
    99         (s-updt ctx src (number-of-bytes src)) )
     100      (let ((src (blob/slice src start end)))
     101          (s-updt ctx src (blob-size src)) ) )
    100102    ((string? src)
    101         (s-updt ctx src (string-length src))
    102         #; ;don't be pedantic
    103         (do-byte-source-update loc ctx (string->blob src) s-updt r-updt) )
     103      (let ((src (string/slice src start end)))
     104          (s-updt ctx src (string-length src)) ) )
    104105    ((message-digest-raw-chunk? src)
    105106      (let* ((obj (message-digest-raw-chunk-object src))
     
    107108        (unless updtr
    108109          (error loc "primitive does not support raw-update") )
    109         (updtr ctx obj (message-digest-raw-chunk-size src)) ) )
     110        (updtr ctx
     111          obj
     112          (message-digest-raw-chunk-size src)
     113          #;(message-digest-raw-chunk-start src)
     114          ) ) )
    110115    ; more complicated bytes
    111116    ((object->bytevector-like src) =>
    112         (cut do-byte-source-update loc ctx <> s-updt r-updt) )
     117        (cut do-byte-source-update loc ctx <> s-updt r-updt start end) )
    113118    ; too complicated bytes
    114119    (else
    115       (signal-type-error loc "indigestible object" src) ) ) )
     120      (signal-type-error loc "indigestible object" src start end) ) ) )
    116121
    117122;;
     
    127132;;
    128133
    129 (define (message-digest-update-object md obj)
     134(define (message-digest-update-object md obj #!optional (start 0) (end #f))
    130135  (do-object-update
    131136    'message-digest-update-object
    132137    (check-message-digest 'message-digest-update-object md)
    133     obj) )
     138    obj
     139    start end) )
    134140
    135141;;
     
    139145    'message-digest-update-procedure
    140146    (check-message-digest 'message-digest-update-procedure md)
    141     (check-procedure 'message-digest-update-procedure proc)) )
     147    (check-procedure 'message-digest-update-procedure proc)
     148    0 #f) )
    142149
    143150;;
     
    147154    'message-digest-update-port
    148155    (check-message-digest 'message-digest-update-port md)
    149     (check-input-port 'message-digest-update-port in)) )
     156    (check-input-port 'message-digest-update-port in)
     157    0 #f) )
    150158
    151159;;
     
    174182        (abort exn) )
    175183      ;in
    176       (do-procedure-update loc md (get-fileno-chunk-reader fd)) )
     184      (do-procedure-update loc md (get-fileno-chunk-reader fd) 0 #f) )
    177185    (file-close fd) ) )
    178186
     
    187195        (abort exn) )
    188196      ;in
    189       (do-port-update loc md in) )
     197      (do-port-update loc md in 0 #f) )
    190198    (close-input-port in) ) )
    191199
  • release/4/message-digest/trunk/message-digest.meta

    r34373 r34426  
    1010        (setup-helper "1.5.2")
    1111        (miscmacros "2.91")
    12         (check-errors "1.13.0")
     12        (check-errors "2.1.0")
    1313        (blob-utils "1.0.0")
    14         (string-utils "1.2.1"))
     14        (string-utils "1.2.1")
     15        (mathh "3.2.0"))
    1516 (test-depends test)
    1617 (files
Note: See TracChangeset for help on using the changeset viewer.