Changeset 39840 in project

Timestamp:

04/05/21 07:50:57 (3 weeks ago)

Author:

Kon Lovett

Message:

add srfi-69 hash & version=?... & srfi-128 comparator

Location:

release/5/semantic-version/trunk

Files:

• semantic-version.egg (modified) (1 diff)
• semantic-version.scm (modified) (3 diffs)
• tests/semantic-version-test.scm (modified) (1 diff)

release/5/semantic-version/trunk/semantic-version.egg

@@ -7 +7 @@
  (author "Kon Lovett")
  (license "BSD")
- (dependencies srfi-1 (string-utils "2.5.0"))
+ (dependencies srfi-1 srfi-128 (string-utils "2.5.0"))
  (test-dependencies test)
  (components

release/5/semantic-version/trunk/semantic-version.scm

@@ -13 +13 @@
   version-valid?
   version-compare
+  version<? version=? version>? version<=? version>=?
+  version-hash
+  version-comparator
   version-parse
   version-string
   version-parts
   version-puncs
-  version-inc!
-  version-dec!
-  version-inc
-  version-dec)
+  version-inc! version-dec!
+  version-inc version-dec)
 
 (import scheme
@@ -28 +29 @@
   (only (chicken string) ->string string-compare3)
   (only (srfi 1) make-list list-copy drop-while map! reverse! every)
+  (only (srfi 69) equal?-hash)
+  (only (srfi 128) make-comparator)
   string-utils)
 
@@ -130 +133 @@
             cmp ) ) ) ) ) )
 
+(define (version<? ver1 ver2 #!key (tail-zero? #f))
+  (negative? (version-compare ver1 ver2 #:tail-zero? tail-zero?)) )
+
+(define (version=? ver1 ver2 #!key (tail-zero? #f))
+  (zero? (version-compare ver1 ver2 #:tail-zero? tail-zero?)) )
+
+(define (version>? ver1 ver2 #!key (tail-zero? #f))
+  (positive? (version-compare ver1 ver2 #:tail-zero? tail-zero?)) )
+
+(define (version<=? ver1 ver2 #!key (tail-zero? #f))
+  (<= (version-compare ver1 ver2 #:tail-zero? tail-zero?) 0) )
+
+(define (version>=? ver1 ver2 #!key (tail-zero? #f))
+  (>= (version-compare ver1 ver2 #:tail-zero? tail-zero?) 0) )
+
+;srfi-69
+(define-constant hash-default-bound 536870912)
+
+(define (version-hash ver #!optional (bnd hash-default-bound))
+  (equal?-hash ver bnd) )
+
+(define (version-comparator)
+  (make-comparator version-valid? version=? version<? version-hash) )
+
 (define (version-parse str)
   (define (str/num x) (or (string->number x) x))

release/5/semantic-version/trunk/tests/semantic-version-test.scm

@@ -34 +34 @@
 (test-assert (zero? (version-compare (make-version 1 2 3) (make-version 1 2 3 0))))
 
+;;
+
+(import (srfi 128))
+
+(let ((cmptr (version-comparator)))
+  (test-assert (comparator-test-type cmptr (make-version "a" 2 "c")))
+  (glossf "Hash: ~A" (comparator-hash cmptr (make-version "a" 2 "c")))
+  (test-assert (<? cmptr (make-version 1 2 3) (make-version 1 11 3)))
+  (test-assert (=? cmptr (make-version 1 2 3) (make-version 1 2 3)))
+  (test-assert (>=? cmptr (make-version 1 11 3) (make-version 1 2 3))) )
+
 ;;;