Changeset 35346 in project


Ignore:
Timestamp:
03/26/18 07:17:12 (6 months ago)
Author:
kon
Message:

export -port in egg module, use const naming pattern, reflow

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

Legend:

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

    r34373 r35346  
    1717  message-digest-srfi-4
    1818  message-digest-update-item
    19   message-digest-item)
     19  message-digest-item
     20  message-digest-port)
    2021(require-library
    2122  message-digest-primitive
     
    2627  message-digest-srfi-4
    2728  message-digest-update-item
    28   message-digest-item)
     29  message-digest-item
     30  message-digest-port)
    2931
    3032) ;module message-digest
  • release/4/message-digest/trunk/tests/message-digest-test.scm

    r35343 r35346  
    2121(define simple-res (ashexstr simple-src))
    2222
    23 (define-constant digest-length 5)
    24 (define-constant context-size 10)
    25 (define-constant block-length 64)
     23(define-constant DIGEST-LENGTH 5)
     24(define-constant CONTEXT-SIZE 10)
     25(define-constant BLOCK-LENGTH 64)
    2626
    2727(define-constant BLOCK-LENGTH-DEFAULT 4)
     
    3737        (set! x #f)
    3838        res ) ) ) )
     39
     40;FIXME add (mock-*-primitive ...) that wraps the supplied phase procedures
    3941
    4042;;
     
    7779
    7880  (let (
    79     (mdp (make-message-digest-primitive context-size digest-length init update final)) )
     81    (mdp (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final)) )
    8082    (test-assert (message-digest-primitive? mdp))
    81     (test context-size (message-digest-primitive-context-info mdp))
    82     (test digest-length (message-digest-primitive-digest-length mdp))
     83    (test CONTEXT-SIZE (message-digest-primitive-context-info mdp))
     84    (test DIGEST-LENGTH (message-digest-primitive-digest-length mdp))
    8385    (test init (message-digest-primitive-init mdp))
    8486    (test update (message-digest-primitive-update mdp))
     
    9193  (let (
    9294    (mdp
    93       (make-message-digest-primitive context-size digest-length init update final 'foo)) )
     95      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final 'foo)) )
    9496    (test BLOCK-LENGTH-DEFAULT (message-digest-primitive-block-length mdp))
    9597    (test 'foo (message-digest-primitive-name mdp)) )
     
    9799  (let (
    98100    (mdp
    99       (make-message-digest-primitive context-size digest-length init update final block-length)) )
    100     (test block-length (message-digest-primitive-block-length mdp))
     101      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final BLOCK-LENGTH)) )
     102    (test BLOCK-LENGTH (message-digest-primitive-block-length mdp))
    101103    (test-assert (symbol? (message-digest-primitive-name mdp))) )
    102104
    103105  (let (
    104106    (mdp
    105       (make-message-digest-primitive context-size digest-length init update final block-length 'foo)) )
    106     (test block-length (message-digest-primitive-block-length mdp))
     107      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final BLOCK-LENGTH 'foo)) )
     108    (test BLOCK-LENGTH (message-digest-primitive-block-length mdp))
    107109    (test 'foo (message-digest-primitive-name mdp)) )
    108110)
     
    123125    (assert (not (not bytes)))
    124126    (assert (< 0 count))
    125     (assert (<= count context-size))  ; So no mem overflow
     127    (assert (<= count CONTEXT-SIZE))  ; So no mem overflow
    126128    (assert (pointer? ctx))
    127129    (assert (blob? bytes))
     
    136138    (assert (or (blob? result) (string? result)))
    137139    ; So no mem overflow
    138     (assert (<= digest-length (if (blob? result) (blob-size result) (string-length result))))
    139     (move-memory! ctx result digest-length) )
    140 
    141   (let (
    142     (mdp (make-message-digest-primitive context-size digest-length init update final)) )
     140    (assert (<= DIGEST-LENGTH (if (blob? result) (blob-size result) (string-length result))))
     141    (move-memory! ctx result DIGEST-LENGTH) )
     142
     143  (let (
     144    (mdp (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final)) )
    143145    (let (
    144146      (md (initialize-message-digest mdp)) )
     
    171173
    172174  (define (make-context)
    173     (make-blob context-size) )
     175    (make-blob CONTEXT-SIZE) )
    174176
    175177  (define (init ctx)
     
    183185    (assert (not (not bytes)))
    184186    (assert (< 0 count))
    185     (assert (<= count context-size))  ; So no mem overflow
     187    (assert (<= count CONTEXT-SIZE))  ; So no mem overflow
    186188    (assert (blob? ctx))
    187189    (assert (blob? bytes))
     
    195197    (assert (blob? ctx))
    196198    (assert (blob? result))
    197     (assert (<= (blob-size result) digest-length))  ; So no mem overflow
    198     (move-memory! ctx result digest-length) )
     199    (assert (<= (blob-size result) DIGEST-LENGTH))  ; So no mem overflow
     200    (move-memory! ctx result DIGEST-LENGTH) )
    199201
    200202  (let* (
    201     (mdp (make-message-digest-primitive make-context digest-length init update final))
     203    (mdp (make-message-digest-primitive make-context DIGEST-LENGTH init update final))
    202204    (md (initialize-message-digest mdp)) )
    203205    (test-assert (message-digest? md))
     
    211213
    212214  (define (make-context)
    213     ;Init to 0 necessary since digest-length is possibly > than
     215    ;Init to 0 necessary since DIGEST-LENGTH is possibly > than
    214216    ;the input size! (Actually just needs to be a known value,
    215217    ;`(integer->char #xff)' would work as well.)
    216     (string->blob (make-string context-size #\nul)) )
     218    (string->blob (make-string CONTEXT-SIZE #\nul)) )
    217219
    218220  (define (init ctx)
     
    224226    (assert (not (not bytes)))
    225227    (assert (< 0 count))
    226     (assert (<= count context-size))  ; So no mem overflow
     228    (assert (<= count CONTEXT-SIZE))  ; So no mem overflow
    227229    (assert (blob? ctx))
    228230    (move-memory! bytes ctx count) )
     
    233235    (assert (not (not result)))
    234236    (assert (blob? ctx))
    235     (assert (<= (blob-size result) digest-length))  ; So no mem overflow
    236     (move-memory! ctx result digest-length) )
    237 
    238   (define mdp (make-message-digest-primitive make-context digest-length init update final))
     237    (assert (<= (blob-size result) DIGEST-LENGTH))  ; So no mem overflow
     238    (move-memory! ctx result DIGEST-LENGTH) )
     239
     240  (define mdp (make-message-digest-primitive make-context DIGEST-LENGTH init update final))
    239241
    240242  (test-group "u8vector Source"
    241     (let ((md (initialize-message-digest mdp)))
     243    (let (
     244      (md (initialize-message-digest mdp)) )
    242245      (test-assert (message-digest-update-u8vector md (u8vector 1 2 3 4 5)))
    243246      (test "0102030405" (finalize-message-digest md)) )
     
    245248
    246249  (test-group "u8 Source"
    247     (let ((md (initialize-message-digest mdp)))
     250    (let (
     251      (md (initialize-message-digest mdp)) )
    248252      (test-assert (message-digest-update-u8 md #xA2))
    249253      (test "a200000000" (finalize-message-digest md)) )
     
    251255
    252256  (test-group "u16-le Source"
    253     (let ((md (initialize-message-digest mdp)))
     257    (let (
     258      (md (initialize-message-digest mdp)) )
    254259      (test-assert (message-digest-update-u16-le md #xA2B2))
    255260      (test "b2a2000000" (finalize-message-digest md)) )
     
    257262
    258263  (test-group "u32-be Source"
    259     (let ((md (initialize-message-digest mdp)))
     264    (let (
     265      (md (initialize-message-digest mdp)) )
    260266      (test-assert (message-digest-update-u32-be md 1073741823))
    261267      (test "3fffffff00" (finalize-message-digest md)) )
     
    264270  (when (version>=? (chicken-version) "4.6.4")
    265271          (test-group "u32-be Source"
    266                         (let ((md (initialize-message-digest mdp)))
     272                        (let (
     273        (md (initialize-message-digest mdp)) )
    267274                                (test-assert (message-digest-update-u32-be md #xA2B2C2D2))
    268275                                (test "a2b2c2d200" (finalize-message-digest md)) )
     
    271278  (when (version>=? (chicken-version) "4.8.1")
    272279                (test-group "u64-be Source"
    273                         (let ((md (initialize-message-digest mdp)))
     280                        (let (
     281        (md (initialize-message-digest mdp)) )
    274282                                (test-assert (message-digest-update-u64-be md #xAB54A98CEB1F0AD2))
    275283                                (test
    276                                   (substring "ab54a98ceb1f0ad2" 0 (fx* 2 (fxmin 8 digest-length)))
     284                                  (substring "ab54a98ceb1f0ad2" 0 (fx* 2 (fxmin 8 DIGEST-LENGTH)))
    277285                                  (finalize-message-digest md)) )
    278286                ) )
    279287
    280288  (test-group "char-u8 Source"
    281     (let ((md (initialize-message-digest mdp)))
     289    (let (
     290      (md (initialize-message-digest mdp)) )
    282291      (test-assert (message-digest-update-char-u8 md #\space))
    283292      (test "2000000000" (finalize-message-digest md)) )
     
    285294
    286295  (test-group "char-be Source"
    287     (let ((md (initialize-message-digest mdp)))
     296    (let (
     297      (md (initialize-message-digest mdp)) )
    288298      (test-assert (message-digest-update-char-be md #\u0003BB))
    289299      (test "000003bb00" (finalize-message-digest md)) )
     
    291301
    292302  (test-group "char-le Source"
    293     (let ((md (initialize-message-digest mdp)))
     303    (let (
     304      (md (initialize-message-digest mdp)) )
    294305      (test-assert (message-digest-update-char-le md #\u0003BB))
    295306      (test "bb03000000" (finalize-message-digest md)) )
     
    320331
    321332  (define (make-context)
    322     (string->blob (make-string context-size #\nul)) )
     333    (string->blob (make-string CONTEXT-SIZE #\nul)) )
    323334
    324335  (define (init ctx)
     
    329340    (assert (not (not bytes)))
    330341    (assert (< 0 count))
    331     (assert (<= count context-size))  ; So no mem overflow
     342    (assert (<= count CONTEXT-SIZE))  ; So no mem overflow
    332343    (assert (blob? ctx))
    333344    (move-memory! bytes ctx count) )
     
    337348    (assert (not (not result)))
    338349    (assert (blob? ctx))
    339     (assert (<= (blob-size result)  digest-length))  ; So no mem overflow
    340     (move-memory! ctx result digest-length) )
     350    (assert (<= (blob-size result)  DIGEST-LENGTH))  ; So no mem overflow
     351    (move-memory! ctx result DIGEST-LENGTH) )
    341352
    342353  (test-group "Primitive Apply (DEPRECATED)"
    343354    (let* (
    344355      (mdp
    345         (make-message-digest-primitive context-size digest-length init update final))
     356        (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final))
    346357      (res (message-digest-primitive-apply mdp simple-src)) )
    347358      (test-assert (string? res))
     
    350361
    351362  (test-group "Make (DEPRECATED)"
    352     (test simple-src (make-binary-message-digest simple-src make-context digest-length init update final))
    353     (test simple-res (make-message-digest simple-src make-context digest-length init update final))
     363    (test simple-src (make-binary-message-digest simple-src make-context DIGEST-LENGTH init update final))
     364    (test simple-res (make-message-digest simple-src make-context DIGEST-LENGTH init update final))
    354365  )
    355366)
     
    370381    (assert (not (not bytes)))
    371382    (assert (< 0 count))
    372     (assert (<= count context-size))
     383    (assert (<= count CONTEXT-SIZE))
    373384    (assert (pointer? ctx))
    374385    (move-memory! bytes ctx count) )
     
    381392    (assert (= SHORT-TEST-FILE-LENGTH count))
    382393    (assert (pointer? ctx))
    383     (move-memory! bytes ctx (min context-size count)) )
    384 
    385   (define (final ctx result)
    386     ;(printf " Final Ctx: ~S Length: ~S Result: ~S~%" ctx digest-length result)
    387     (assert (eq? ctx the-ctx))
    388     (assert (not (not result)))
    389     (assert (pointer? ctx))
    390     ;(assert (<= 0 digest-length))
    391     (move-memory! ctx result digest-length) )
     394    (move-memory! bytes ctx (min CONTEXT-SIZE count)) )
     395
     396  (define (final ctx result)
     397    ;(printf " Final Ctx: ~S Length: ~S Result: ~S~%" ctx DIGEST-LENGTH result)
     398    (assert (eq? ctx the-ctx))
     399    (assert (not (not result)))
     400    (assert (pointer? ctx))
     401    ;(assert (<= 0 DIGEST-LENGTH))
     402    (move-memory! ctx result DIGEST-LENGTH) )
    392403
    393404  (let (
    394405    (mdp
    395       (make-message-digest-primitive context-size digest-length init update final raw-update)) )
     406      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final raw-update)) )
    396407    (test "6162636465" (message-digest-file mdp SHORT-TEST-FILE-NAME 'hex-string)) )
    397408)
Note: See TracChangeset for help on using the changeset viewer.