Changeset 39858 in project


Ignore:
Timestamp:
04/06/21 00:44:50 (4 months ago)
Author:
Kon Lovett
Message:

use record-variant, rename accessors, make-version/version follow convention, add record printer

Location:
release/5/semantic-version/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/5/semantic-version/trunk/README.svnwiki

    r39851 r39858  
    88== Documentation
    99
    10 Semantic-Version handling.
     10A rather busy Semantic Versioning library.
    1111
    1212== Usage
     
    1818=== version-punctuation
    1919
    20 <procedure>(version-punctuation [STR]) -> string</procedure>
     20<parameter>(version-punctuation [STR]) -> string</parameter>
    2121
    2222Returns the string (set) of punctuation characters. The first is always the
    2323default.
    2424
    25 ; STR : {{string}} ; default is "._- +;:,"
     25; STR : {{string}} ; punctuation set, default is "._- +;:,"
    2626
    2727=== version-tail-zero
    2828
    29 <procedure>(version-tail-zero [BOOL]) -> boolean</procedure>
     29<parameter>(version-tail-zero [IGN?]) -> boolean</parameter>
    3030
    3131Returns whether trailing 0's are ignored during comparision.
    3232
     33; IGN? : {{boolean}} ; ignore flag, default is {{#f}}.
     34
    3335=== make-version
     36
     37<procedure>(make-version VER CNT ELM [CHR]) --> version</procedure>
     38
     39Returns new version with CNT elements, ELM, and punctuation CHR.
     40
     41; VER : {{version}} ; version to extend.
     42; CNT : {{integer}} ; element count.
     43; ELM : {{(or number string symbol)}} ; version element.
     44; CHR : {{char}} ; version punctuation, default is as above.
     45
     46=== version
     47
     48<procedure>(version ELM...) --> version</procedure>
     49
     50Returns a new version with the specified elements, ELM..., and the default
     51punctuation (see {{version-punctuation}}).
     52
     53; ELM : {{(or number string symbol)}} ; version element.
     54
     55'''Note''' that the {{symbol}} printname is used internally.
     56Returns whether trailing 0's are ignored during comparision.
     57
    3458=== check-version
    3559=== error-version
    3660
    37 <procedure>(make-version ELM...) --> version</procedure>
    3861<procedure>(check-version LOC OBJ [NAM]) -> version</procedure>
    3962<procedure>(error-version LOC OBJ [NAM])</procedure>
    4063
    41 Returns a new version with the specified elements, ELM..., and the default
    42 punctuation (see {{version-punctuation}}).
    43 
    44 ; ELM : {{(or number string symbol)}} ; version element.
    45 
    46 '''Note''' that the {{symbol}} printname is used internally.
    47 Returns whether trailing 0's are ignored during comparision.
     64Similar to ''check-errors'' procedures.
    4865
    4966=== version-copy
     
    6986; VER : {{version}} ; version to query.
    7087
    71 === version-parts
    72 
    73 <procedure>(version-parts VER) --> list</procedure>
     88=== version-elements
     89
     90<procedure>(version-elements VER) --> (list-of (or number string))</procedure>
    7491
    7592Returns list of version elements.
     
    7794; VER : {{version}} ; version to query.
    7895
    79 === version-puncs
    80 
    81 <procedure>(version-puncs VER) --> list</procedure>
    82 
    83 Returns list of separator characters.
     96=== version-separators
     97
     98<procedure>(version-separators VER) --> (list-of char)</procedure>
     99
     100Returns list of separator characters (punctuation).
    84101
    85102; VER : {{version}} ; version to query.
     
    147164Returns a SRFI 128 {{comparator}} for the {{version}} type.
    148165
     166; {{comparator-hash-function}} : {{version-hash}}
     167; {{comparator-type-test-predicate}} : {{version?}}
     168; {{comparator-equality-predicate comparator}} : {{version=?}}
     169; {{comparator-ordering-predicate comparator}} : {{version<?}}
     170
    149171=== string->version
    150172
     
    154176preserved, and restored by {{version->string}}.
    155177
    156 ; STR : {{string}} ; version string.
     178; STR : {{string}} ; string to convert.
    157179
    158180=== version->string
     
    162184Return the string form of the VER.
    163185
    164 ; VER : {{version}} ; version to hash.
     186; VER : {{version}} ; version to convert.
    165187
    166188=== version-depth+!
    167189
    168 <procedure>(version-depth+! VER CNT PART [PUNC]) -> version</procedure>
    169 
    170 Returns VER with more "depth", as PART, interspersed with PUNC.
    171 
    172 ; VER : {{version}} ; version to extend.
    173 ; CNT : {{integer}} ; element count.
    174 ; PART : {{(or number string symbol)}} ; version element.
    175 ; PUNC : {{char}} ; version punctuation, default is as above.
     190<procedure>(version-depth+! VER CNT ELM [CHR]) -> version</procedure>
     191
     192Returns VER with more "depth", as ELM, interspersed with CHR.
     193
     194; VER : {{version}} ; version to extend.
     195; CNT : {{integer}} ; element count.
     196; ELM : {{(or number string symbol)}} ; version element.
     197; CHR : {{char}} ; version punctuation, default is as above.
    176198
    177199=== version-depth-!
     
    187209=== version-depth+
    188210
    189 <procedure>(version-depth+ VER CNT PART [PUNC]) --> version</procedure>
    190 
    191 Returns a copy of VER with more "depth", as PART, interspersed with PUNC.
    192 
    193 ; VER : {{version}} ; version to extend.
    194 ; CNT : {{integer}} ; element count.
    195 ; PART : {{(or number string symbol)}} ; version element.
    196 ; PUNC : {{char}} ; version punctuation, default is as above.
     211<procedure>(version-depth+ VER CNT ELM [CHR]) --> version</procedure>
     212
     213Returns a copy of VER with more "depth", as ELM, interspersed with CHR.
     214
     215; VER : {{version}} ; version to extend.
     216; CNT : {{integer}} ; element count.
     217; ELM : {{(or number string symbol)}} ; version element.
     218; CHR : {{char}} ; version punctuation, default is as above.
    197219
    198220=== version-depth-
     
    218240=== version-extend
    219241
    220 <procedure>(version-extend VER  COMP...) --> version</procedure>
     242<procedure>(version-extend VER COMP...) --> version</procedure>
    221243
    222244Returns copy of VER with added "depth", in the form of a new "tail", in
     
    228250=== version-inc!
    229251
    230 <procedure>(version-inc! VER [INDEX AMOUNT]) -> version</procedure>
    231 
    232 Return VER with INDEX element incremented by AMOUNT.
     252<procedure>(version-inc! VER [IDX AMT]) -> version</procedure>
     253
     254Return VER with IDX element incremented by AMT.
    233255
    234256; VER : {{version}} ; version to adjust.
    235 ; INDEX : {{integer}} ; which element to adjust.
    236 ; AMOUNT : {{number}} ; amount to adjust.
     257; IDX : {{integer}} ; which element to adjust.
     258; AMT : {{number}} ; amount to adjust.
    237259
    238260Currently only {{number}} elements may be targets.
     
    240262=== version-dec!
    241263
    242 <procedure>(version-dec! VER [INDEX AMOUNT]) -> version</procedure>
    243 
    244 Return VER with INDEX element decremented by AMOUNT.
     264<procedure>(version-dec! VER [IDX AMT]) -> version</procedure>
     265
     266Return VER with IDX element decremented by AMT.
    245267
    246268; VER : {{version}} ; version to adjust.
    247 ; INDEX : {{integer}} ; which element to adjust.
    248 ; AMOUNT : {{number}} ; amount to adjust.
     269; IDX : {{integer}} ; which element to adjust.
     270; AMT : {{number}} ; amount to adjust.
    249271
    250272Currently only {{number}} elements may be targets.
     
    252274=== version-inc
    253275
    254 <procedure>(version-inc VER [INDEX AMOUNT]) --> version</procedure>
    255 
    256 Return copy of VER with INDEX element incremented by AMOUNT.
     276<procedure>(version-inc VER [IDX AMT]) --> version</procedure>
     277
     278Return copy of VER with IDX element incremented by AMT.
    257279
    258280; VER : {{version}} ; version to adjust.
    259 ; INDEX : {{integer}} ; which element to adjust.
    260 ; AMOUNT : {{number}} ; amount to adjust.
     281; IDX : {{integer}} ; which element to adjust.
     282; AMT : {{number}} ; amount to adjust.
    261283
    262284Currently only {{number}} elements may be targets.
     
    264286=== version-dec
    265287
    266 <procedure>(version-dec VER [INDEX AMOUNT]) --> version</procedure>
    267 
    268 Return copy of VER with INDEX element decremented by AMOUNT.
     288<procedure>(version-dec VER [IDX AMT]) --> version</procedure>
     289
     290Return copy of VER with IDX element decremented by AMT.
    269291
    270292; VER : {{version}} ; version to adjust.
    271 ; INDEX : {{integer}} ; which element to adjust.
    272 ; AMOUNT : {{number}} ; amount to adjust.
     293; IDX : {{integer}} ; which element to adjust.
     294; AMT : {{number}} ; amount to adjust.
    273295
    274296Currently only {{number}} elements may be targets.
     
    291313;=> #t
    292314; but, assuming baseline `version-punctuation'
    293 (string=? "a.1.b" (version->string (make-version 'a 1 'b)))
     315(string=? "a.1.b" (version->string (version 'a 1 'b)))
    294316;=> #t
    295317
    296 (define ver1 (make-version 'a 1 'b 2))
     318(define ver1 (version 'a 1 'b 2))
    297319((o print version->string) ver1)
    298320;=> "a.1.b.2"
     
    311333[[srfi-69]]
    312334[[srfi-128]]
    313 [[string-utils]]
     335[[utf8]]
    314336
    315337[[test]]
     
    323345== Version history
    324346
     347; 0.0.2 : Use record, {{make-version}} & {{version}} follow convention, rename accessors.
    325348; 0.0.1 : Release.
    326349
  • release/5/semantic-version/trunk/semantic-version.egg

    r39852 r39858  
    33
    44((synopsis "Semantic Version Utilities")
    5  (version "0.0.1")
     5 (version "0.0.2")
    66 (category data)
    77 (author "Kon Lovett")
  • release/5/semantic-version/trunk/semantic-version.scm

    r39852 r39858  
    1414  version-tail-zero
    1515  make-version
     16  version
    1617  version-copy
    1718  version? check-version error-version
    1819  version-depth
    19   version-parts
    20   version-puncs
     20  version-elements
     21  version-separators
    2122  list->version
    2223  version->list
     
    4344  (chicken type)
    4445  (chicken condition)
     46  (chicken format)
    4547  (only (chicken string) ->string string-compare3)
    4648  (only (srfi 1) make-list list-copy drop-while reverse! append! drop-right! every map-in-order)
     
    4951  (only (srfi 128) make-comparator))
    5052
     53;;record-variants
     54
     55(define-syntax define-record-type-variant
     56  (er-macro-transformer
     57   (lambda (form r c)
     58     (define (any p L)
     59       (and (pair? L)
     60            (or (p (car L))
     61                (any p (cdr L)))))
     62     (##sys#check-syntax 'define-record-type-variant form
     63                         '(_ _ #(variable 0)
     64                             #(variable 1) _ . _))
     65     (let* ((name-spec (cadr form))
     66            (name (if (pair? name-spec) (car name-spec) name-spec))
     67            (t (if (pair? name-spec) (cadr name-spec) name-spec))
     68            (variant? (lambda (type) (any (lambda (x) (c x (r type)))
     69                                          (caddr form))))
     70            (unsafe? (variant? 'unsafe))
     71            (unchecked? (variant? 'unchecked))
     72            (inline? (variant? 'inline))
     73            (constructor? (eq? name t))
     74
     75            (conser (cadddr form))
     76            (predspec (car (cddddr form)))
     77            (pred (if (pair? predspec) (car predspec) predspec))
     78            (checker (if (and (pair? predspec)
     79                              (pair? (cdr predspec)))
     80                         (cadr predspec) #f))
     81            (slots (cdr (cddddr form)))
     82            (%begin (r 'begin))
     83            (%lambda (r 'lambda))
     84            (%define (if inline? (r 'define-inline) (r 'define)))
     85            (vars (cdr conser))
     86            (x (r 'x))
     87            (y (r 'y))
     88            (%getter-with-setter (r 'getter-with-setter))
     89            (slotnames (map car slots)))
     90       `(,%begin
     91         ,(if constructor?
     92              `(,%define ,conser
     93                         (##sys#make-structure
     94                          ,t
     95                          ,@(map (lambda (sname)
     96                                   (if (memq sname vars)
     97                                       sname
     98                                       '(##core#undefined)))
     99                                 slotnames)))
     100              `(,%begin))
     101         (,%define (,pred ,x) (##sys#structure? ,x ,t))
     102         ,(if checker
     103              `(,%define (,checker ,x)
     104                         (##core#check (##sys#check-structure ,x ,t)))
     105              `(,%begin))
     106         ,@(let loop ([slots slots] [i 1])
     107             (if (null? slots)
     108                 '()
     109                 (let* ([slot (car slots)]
     110                        (setters (memq #:record-setters ##sys#features))
     111                        (setr? (pair? (cddr slot)))
     112                        (getr `(,%lambda (,x)
     113                                         ,(if unchecked?
     114                                              `(,%begin)
     115                                              `(##core#check
     116                                                (##sys#check-structure ,x ,t)))
     117                                         ,(if unsafe?
     118                                              `(##sys#slot ,x ,i)
     119                                              `(##sys#block-ref ,x ,i)))))
     120                   `(,@(if setr?
     121                           `((,%define (,(caddr slot) ,x ,y)
     122                                       ,(if unchecked?
     123                                            `(,%begin)
     124                                            `(##core#check
     125                                              (##sys#check-structure ,x ,t)))
     126                                       ,(if unsafe?
     127                                            `(##sys#setslot ,x ,i ,y)
     128                                            `(##sys#block-set! ,x ,i ,y))))
     129                           '())
     130                     (,%define ,(cadr slot)
     131                               ,(if (and setr? setters)
     132                                    `(,%getter-with-setter ,getr ,(caddr slot))
     133                                    getr) )
     134                     ,@(loop (cdr slots) (add1 i)))))))))))
     135
    51136;;
    52137
     
    56141(define-type ver-parts (list-of ver-part))
    57142(define-type ver-puncs (list-of ver-punc))
    58 (define-type ver       (pair ver-parts ver-puncs))
     143(define-type ver       (struct semantic-version))
    59144
    60145(: version-punctuation  (#!optional string -> string))
    61146(: version-tail-zero    (#!optional boolean -> boolean))
    62147
    63 (: make-version         (#!rest ver-part --> ver))
     148(: make-version         (integer ver-part #!optional ver-punc --> ver))
     149(: version              (#!rest ver-part --> ver))
    64150(: version?             (* -> boolean : ver))
    65151(: check-version        (symbol * #!optional (or string symbol) -> ver))
     
    67153(: version-copy         (ver --> ver))
    68154(: version-depth        (ver --> integer))
    69 (: version-parts        (ver --> ver-parts))
    70 (: version-puncs        (ver --> ver-puncs))
     155(: version-elements     (ver --> ver-parts))
     156(: version-separators   (ver --> ver-puncs))
    71157(: list->version        ((list-of (or ver-part ver-punc)) --> ver))
    72158(: version->list        (ver --> (list-of (or ver-part ver-punc))))
     
    100186(define (ver-punc? x) (char? x))
    101187
    102 (define (make-ver cs ps)      (cons cs ps))
    103 (define (ver-parts v)         (car v))
    104 (define (ver-puncs v)         (cdr v))
    105 (define (ver-parts-set! v x)  (set-car! v x))
    106 (define (ver-puncs-set! v x)  (set-cdr! v x))
    107 (define (ver? x)              (and (pair? x) (list? (ver-parts x)) (list? (ver-puncs x))))
    108 (define (copy-ver v)          (make-ver (list-copy (ver-parts v)) (list-copy (ver-puncs v))))
    109 
    110 (define (ver-parts? x) (every ver-part? x))
    111 (define (ver-puncs? x) (every ver-punc? x))
     188(define semantic-version 'semantic-version)
     189(define-record-type-variant semantic-version (unsafe unchecked inline)
     190  (make-ver cs ps)
     191  ver?
     192  (cs ver-parts ver-parts-set!)
     193  (ps ver-puncs ver-puncs-set!))
     194
     195(define (vertyp? x) (and (ver? x) (list? (ver-parts x)) (list? (ver-puncs x))))
     196
     197(define (copy-ver v) (make-ver (list-copy (ver-parts v)) (list-copy (ver-puncs v))))
     198
     199(define (ver-parts? l) (every ver-part? l))
     200(define (ver-puncs? l) (every ver-punc? l))
    112201
    113202(define (vererrmsg msg nam)
     
    145234  (make-list (sub1 (length parts)) (default-punctuation)) )
    146235
    147 (define (make-version . parts)
    148   (if (null? (check-parts 'make-version parts)) (make-ver '() '())
     236(define (make-version cnt part #!optional (punc (default-punctuation)))
     237  (check-parts 'make-version (list part))
     238  (check-puncs 'make-version (list punc))
     239  (make-ver (make-list cnt part) (make-list (min 0 (sub1 cnt)) punc)) )
     240
     241(define (version . parts)
     242  (if (null? (check-parts 'version parts)) (make-ver '() '())
    149243    (let ((parts (map (lambda (x) (if (symbol? x) (symbol->string x) x)) parts)))
    150244      (make-ver parts (default-puncs parts))) ) )
     
    152246(define (version? ver)
    153247  (and
    154     (ver? ver)
     248    (vertyp? ver)
    155249    (let ((parts (ver-parts ver)) (puncs (ver-puncs ver)))
    156250      (or
     
    165259
    166260(define (check-version loc x #!optional nam)
    167   (unless (ver? x) (error-version loc x nam))
     261  (unless (vertyp? x) (error-version loc x nam))
    168262  (check-parts loc (ver-parts x) nam)
    169263  (check-puncs loc (ver-puncs x) nam)
     
    176270  (length (ver-parts (check-version 'version-depth ver))) )
    177271
    178 (define (version-parts ver)
    179   (list-copy (ver-parts (check-version 'version-parts ver))) )
    180 
    181 (define (version-puncs ver)
    182   (list-copy (ver-puncs (check-version 'version-puncs ver))) )
     272(define (version-elements ver)
     273  (list-copy (ver-parts (check-version 'version-elements ver))) )
     274
     275(define (version-separators ver)
     276  (list-copy (ver-puncs (check-version 'version-separators ver))) )
    183277
    184278(define (version->list ver)
     
    330424  (version-dec! (copy-ver (check-version 'version-dec ver)) idx amt) )
    331425
    332 ) ;semantic-version
     426;; Read/Print Syntax
     427
     428(define (version-print ver out)
     429  (fprintf out "#<version ~S>" (version->string ver)) )
     430
     431;;;
     432
     433(set! (record-printer semantic-version) version-print)
     434
     435) ;module semantic-version
  • release/5/semantic-version/trunk/tests/semantic-version-test.scm

    r39851 r39858  
    1010;;;
    1111
    12 (import semantic-version)
     12(import (chicken port) (srfi 69) (srfi 128) semantic-version)
    1313
    14 (test-error (make-version 'a 2 #\c))
    15 (test-assert (version? (make-version 'a 2 "c")))
     14(test-error (version 'a 2 #\c))
     15(test-assert (version? (version 'a 2 "c")))
     16
     17(test "record print" "#<version \"a.2.c\">" (with-output-to-string (lambda () (display (version 'a 2 "c")))))
    1618
    1719;assumes 1st is always "."
    18 (test (make-version 'a 2 "c") (string->version "a.2.c"))
     20(test (version 'a 2 "c") (string->version "a.2.c"))
    1921
    20 (test 3 (version-depth (make-version 'a 2 "c")))
     22(test 3 (version-depth (version 'a 2 "c")))
    2123
    2224(test-assert (version? (string->version "a.2,c")))
     25(test-assert (not (version? #t)))
     26
    2327(test "a.2,c" (version->string (string->version "a.2,c")))
    2428(let ((ver "a.2,c"))
    25   (test '("a" 2 "c") (version-parts (string->version ver)))
    26   (test '(#\. #\,) (version-puncs (string->version ver))) )
    27 
    28 (test "inc of -# is dec" (make-version "a" 1 "c") (version-inc (make-version "a" 2 "c") 1 -1))
    29 (test "def inc elm is last" (make-version 1 2 4) (version-inc (make-version 1 2 3)))
    30 
    31 (test-assert (negative? (version-compare (make-version 1 2 3) (make-version 1 11 3))))
    32 (test-assert (positive? (version-compare (make-version 1 11 3) (make-version 1 2 3))))
    33 (test-assert (zero? (version-compare (make-version 1 2 3) (make-version 1 2 3))))
    34 
    35 (test-assert (negative? (version-compare (make-version 1 2 3) (make-version 1 2 3 0) #t)))
    36 (test-assert (zero? (version-compare (make-version 1 2 3) (make-version 1 2 3 0))))
     29  (test '("a" 2 "c") (version-elements (string->version ver)))
     30  (test '(#\. #\,) (version-separators (string->version ver))) )
    3731
    3832(test '("a" #\. 2 #\, "c") (version->list (list->version '("a" #\. 2 #\, "c"))))
    3933
    40 (test (string->version "a.2.c,27-X") (version-extend (make-version 'a 2 "c") #\, 27 #\- 'X))
     34(test-assert (negative? (version-compare (version 1 2 3) (version 1 11 3))))
     35(test-assert (positive? (version-compare (version 1 11 3) (version 1 2 3))))
     36(test-assert (zero? (version-compare (version 1 2 3) (version 1 2 3))))
    4137
    42 (test (make-version 'a 2 "c" 0 0) (version-depth+ (make-version 'a 2 "c") 2 0))
    43 (test (make-version 'a) (version-depth- (make-version 'a 2 "c") 2))
     38(test-assert (negative? (version-compare (version 1 2 3) (version 1 2 3 0) #t)))
     39(test-assert (zero? (version-compare (version 1 2 3) (version 1 2 3 0))))
     40
     41(test "inc of -# is dec" (version "a" 1 "c") (version-inc (version "a" 2 "c") 1 -1))
     42(test "def inc elm is last" (version 1 2 4) (version-inc (version 1 2 3)))
     43
     44(test (string->version "a.2.c,27-X") (version-extend (version 'a 2 "c") #\, 27 #\- 'X))
     45
     46(test (version 'a 2 "c" 0 0) (version-depth+ (version 'a 2 "c") 2 0))
     47(test (version 'a) (version-depth- (version 'a 2 "c") 2))
    4448
    4549;;
    4650
    47 (import (srfi 128))
    48 
    4951(let ((cmptr (version-comparator)))
    50   (test-assert (comparator-test-type cmptr (make-version "a" 2 "c")))
    51   (test-assert (integer? (comparator-hash cmptr (make-version "a" 2 "c"))))
    52   (test-assert (<? cmptr (make-version 1 2 3) (make-version 1 11 3)))
    53   (test-assert (=? cmptr (make-version 1 2 3) (make-version 1 2 3)))
    54   (test-assert (>=? cmptr (make-version 1 11 3) (make-version 1 2 3))) )
     52  (test-assert (comparator-test-type cmptr (version "a" 2 "c")))
     53  (test-assert (integer? (comparator-hash cmptr (version "a" 2 "c"))))
     54  (test-assert (<? cmptr (version 1 2 3) (version 1 11 3)))
     55  (test-assert (=? cmptr (version 1 2 3) (version 1 2 3)))
     56  (test-assert (>=? cmptr (version 1 11 3) (version 1 2 3))) )
    5557
    5658;;
    5759
    58 (import (srfi 69))
    59 
    6060(let ((ht (make-hash-table version=? version-hash 10)))
    61   (hash-table-set! ht (make-version "a" 2 "c") 'one)
    62   (hash-table-set! ht (make-version 1 2 3 0) 'two)
    63   (test 'one (hash-table-ref ht (make-version "a" 2 "c")))
    64   (test 'two (hash-table-ref ht (make-version 1 2 3 0)))
    65   (test-error "not found" (hash-table-ref ht (make-version 'a 'd))) )
     61  (hash-table-set! ht (version "a" 2 "c") 'one)
     62  (hash-table-set! ht (version 1 2 3 0) 'two)
     63  (test 'one (hash-table-ref ht (version "a" 2 "c")))
     64  (test 'two (hash-table-ref ht (version 1 2 3 0)))
     65  (test-error "not found" (hash-table-ref ht (version 'a 'd))) )
    6666
    6767;;;
Note: See TracChangeset for help on using the changeset viewer.