Changeset 39839 in project


Ignore:
Timestamp:
04/05/21 02:29:14 (4 months ago)
Author:
Kon Lovett
Message:

add test gloss of version, add failing test of parts (w/ types compiler chimes in on test), add parts/puncs getter, add rt checks

Location:
release/5/semantic-version/trunk
Files:
1 added
2 edited

Legend:

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

    r39833 r39839  
    11;;;; semantic-version.scm  -*- Scheme -*-
    22;;;; Kon Lovett, Apr '21
     3
     4;; Issues
     5;;
     6;; - Support Roman Numerals & Upper/Lowercase Letters ("outline numbers").
    37
    48(module semantic-version
     
    1115  version-parse
    1216  version-string
     17  version-parts
     18  version-puncs
    1319  version-inc!
    1420  version-dec!
     
    2632;;
    2733
    28 ;FIXME convert # <-> S on split & combine, so not in inc & comp?
    29 
    30 (define-type ver-part  (or number string))
     34(define-type ver-part  (or number string symbol))
    3135(define-type ver-punc  char)
    3236(define-type ver-parts (list-of ver-part))
     
    3943(: version-valid?       (ver --> boolean))
    4044(: version-parse        (string -> ver))
    41 (: version-string      (ver -> string))
     45(: version-string       (ver -> string))
     46(: version-parts        (ver -> ver-parts))
     47(: version-puncs        (ver -> ver-puncs))
    4248(: version-inc!         (ver #!optional integer number -> ver))
    4349(: version-dec!         (ver #!optional integer number -> ver))
     
    4955;semantic-version type
    5056
    51 (define (ver-part? x) (or (string? x) (number? x)))
     57(define (ver-part? x) (or (number? x) (string? x) (symbol? x)))
    5258(define (ver-punc? x) (char? x))
    5359
     
    5763(define (ver? x)          (and (pair? x) (list? (ver-parts x)) (list? (ver-puncs x))))
    5864(define (copy-ver v)      (make-ver (list-copy (ver-parts v)) (ver-puncs v)))
     65
     66(define (ver-parts? x) (and (list? x) (every ver-part? x)))
     67(define (ver-puncs? x) (and (list? x) (every ver-punc? x)))
     68
     69(define (check-parts loc x)
     70  (unless (ver-parts? x) (error loc "invalid semantic-version parts" x))
     71  x )
     72
     73(define (check-puncs loc x)
     74  (unless (ver-puncs? x) (error loc "invalid semantic-version puncs" x))
     75  x )
     76
     77(define (check-version loc x)
     78  (unless (ver? x) (error loc "invalid semantic-version" x))
     79  (check-parts loc (ver-parts x))
     80  (check-puncs loc (ver-puncs x))
     81  x )
    5982
    6083;
     
    7497
    7598(define (make-version . parts)
    76   (if (null? parts) (make-ver '() '())
     99  (if (null? (check-parts 'make-version parts)) (make-ver '() '())
    77100    (make-ver parts (default-puncs parts))) )
    78101
    79 ;ver => ?
    80102(define (version-valid? ver)
    81103  (and
    82104    (ver? ver)
    83105    (let ((parts (ver-parts ver)) (puncs (ver-puncs ver)))
    84       (and
    85         (or
    86           (and (null? puncs) (null? parts))
    87           (and
    88             (= (length puncs) (sub1 (length parts)))
    89             (every ver-part? parts)
    90             (every char? puncs) ) ) ) ) ) )
     106      (or
     107        (and (null? puncs) (null? parts))
     108        (and
     109          (= (length puncs) (sub1 (length parts)))
     110          (ver-parts? parts)
     111          (ver-puncs? puncs) ) ) ) ) )
    91112
    92 ;ver1 ver2 => <0 | 0 | >0
    93113(define (version-compare ver1 ver2 #!key (tail-zero? #f))
    94114  (define (tail-zeros ls) (if tail-zero? ls (drop-tailing-zeros ls)))
    95   (let loop ((p1 (tail-zeros (ver-parts ver1))) (p2 (tail-zeros (ver-parts ver2))))
     115  (let loop ((p1 (tail-zeros (ver-parts (check-version 'version-compare ver1))))
     116             (p2 (tail-zeros (ver-parts (check-version 'version-compare ver2)))))
    96117    (cond
    97118      ((and (null? p1) (null? p2))  0)
     
    109130            cmp ) ) ) ) ) )
    110131
    111 ;"..." => ver
    112132(define (version-parse str)
    113133  (define (str/num x) (or (string->number x) x))
     
    115135    (make-ver (map! str/num parts) (map! (cut string-ref <> 0) puncs)) ) )
    116136
    117 ;ver => "..."
    118137(define (version-string ver)
     138  (check-version 'version-string ver)
    119139  (string-zip (map ->string (ver-parts ver)) (map string (ver-puncs ver))) )
    120140
    121 ;iNOTE nc/dec nth ver - "IVX"/"ivx" & "a"/"A"
     141(define (version-parts ver)
     142  (list-copy (ver-parts (check-version 'version-parts ver))) )
    122143
    123 (define (version-inc! ver #!optional (idx (sub1 (length (ver-parts ver)))) (amt 1))
    124   (let loop ((idx idx) (ls (ver-parts ver)))
     144(define (version-puncs ver)
     145  (list-copy (ver-puncs (check-version 'version-puncs ver))) )
     146
     147;default is the last component, better be a number!
     148(define (version-inc! ver #!optional idx (amt 1))
     149  (check-version 'version-inc! ver)
     150  (let loop ((idx (or idx (sub1 (length (ver-parts ver))))) (ls (ver-parts ver)))
    125151    (if (positive? idx) (loop (sub1 idx) (cdr ls))
    126152      (begin
     
    128154        ver ) ) ) )
    129155
    130 (define (version-dec! ver #!optional (idx (sub1 (length (ver-parts ver)))) (amt 1))
    131   (version-inc! ver idx (- amt)) )
     156(define (version-dec! ver #!optional idx (amt 1))
     157  (version-inc! (check-version 'version-dec! ver) idx (- amt)) )
    132158
    133 (define (version-inc ver #!optional (idx (sub1 (length (ver-parts ver)))) (amt 1))
    134   (version-inc! (copy-ver ver) idx amt) )
     159(define (version-inc ver #!optional idx (amt 1))
     160  (version-inc! (copy-ver (check-version 'version-inc ver)) idx amt) )
    135161
    136 (define (version-dec ver #!optional (idx (sub1 (length (ver-parts ver)))) (amt 1))
    137   (version-dec! (copy-ver ver) idx amt) )
     162(define (version-dec ver #!optional idx (amt 1))
     163  (version-dec! (copy-ver (check-version 'version-dec ver)) idx amt) )
    138164
    139165) ;semantic-version
  • release/5/semantic-version/trunk/tests/semantic-version-test.scm

    r39833 r39839  
    33
    44(import test)
     5(import (only (chicken format) format))
     6(include "test-gloss.incl")
    57
    68(test-begin "Semantic Version")
     
    1012(import semantic-version)
    1113
     14(test-error (make-version 'a 2 #\c))
    1215(test-assert (version-valid? (make-version "a" 2 "c")))
    1316
     
    1720(test-assert (version-valid? (version-parse "a.2,c")))
    1821(test "a.2,c" (version-string (version-parse "a.2,c")))
     22(let ((ver "a.2,c"))
     23  (glossf "~S Parts: ~S" ver (version-parts (version-parse ver)))
     24  (glossf "~S Puncs: ~S" ver (version-puncs (version-parse ver))) )
    1925
    20 (test (make-version "a" 1 "c") (version-inc (make-version "a" 2 "c") 1 -1))
    21 (test (make-version 1 2 4) (version-inc (make-version 1 2 3)))
     26(test "inc of -# is dec" (make-version "a" 1 "c") (version-inc (make-version "a" 2 "c") 1 -1))
     27(test "def inc elm is last" (make-version 1 2 4) (version-inc (make-version 1 2 3)))
    2228
    2329(test-assert (negative? (version-compare (make-version 1 2 3) (make-version 1 11 3))))
Note: See TracChangeset for help on using the changeset viewer.