M qlfile => qlfile +1 -0
@@ 4,6 4,7 @@ ql trivial-indent
ql alexandria
ql cl-semver
ql esrap
+ql parachute
git cl-i git@git.sr.ht:~skin/cl-i :branch main
git nrdl git@git.sr.ht:~skin/nrdl :ref 0.3.0
M skin.djha.zippm.asd => skin.djha.zippm.asd +28 -26
@@ 1,29 1,31 @@
(defsystem "skin.djha.zippm"
- :version "0.1.0"
- :author "Daniel Jay Haskin"
- :license "MIT"
- :depends-on (
- "cl-i"
- "alexandria"
- )
- :components ((:module "src"
- :components
- ((:file "main")
- (:file "resolve"))))
- :description ""
- :in-order-to ((test-op (test-op "skin.djha.zippm/tests"))))
+ :version "0.1.0"
+ :author "Daniel Jay Haskin"
+ :license "MIT"
+ :depends-on (
+ "cl-i"
+ "esrap"
+ "cl-semver"
+ "alexandria"
+ )
+ :components ((:module "src"
+ :components
+ ((:file "main")
+ (:file "resolve"))))
+ :description ""
+ :in-order-to ((test-op (test-op "skin.djha.zippm/tests"))))
(defsystem "skin.djha.zippm/tests"
- :author "Daniel Jay Haskin"
- :license "MIT"
- :version "0.1.0"
- :depends-on ("skin.djha.zippm"
- "parachute")
- :components ((:module "tests"
- :components
- ((:file "resolve"))))
- :description "Test system for zippm"
- :perform (test-op (op c)
- (uiop:symbol-call
- :parachute
- :test #:skin.djha.zippm/tests/resolve)))
+ :author "Daniel Jay Haskin"
+ :license "MIT"
+ :version "0.1.0"
+ :depends-on ("skin.djha.zippm"
+ "parachute")
+ :components ((:module "tests"
+ :components
+ ((:file "resolve"))))
+ :description "Test system for zippm"
+ :perform (test-op (op c)
+ (uiop:symbol-call
+ :parachute
+ :test #:skin.djha.zippm/tests/resolve)))
M src/main.lisp => src/main.lisp +23 -23
@@ 15,12 15,12 @@
(let ((strm (gethash :strm options)))
(format strm "~A~%" name)
(loop for k being the hash-keys of options
- using (hash-value v)
- do (format strm "~39@A: ~A~%" k v)
- finally (return (alexandria:alist-hash-table
- `((:status . :successful)
- (:options . ,options))
- :test #'equal)))))
+ using (hash-value v)
+ do (format strm "~39@A: ~A~%" k v)
+ finally (return (alexandria:alist-hash-table
+ `((:status . :successful)
+ (:options . ,options))
+ :test #'equal)))))
(defun athing (options)
(declare (type hash-table options))
@@ 31,23 31,23 @@
The functional entrypoint of the zippm command.
"
(declare (type list argv))
- (cl-i:execute-program
- "zippm"
- (cl-i:system-environment-variables)
- `(
- (("athing") . ,#'athing)
- )
- :helps
- `((("athing") . "A stub function"))
- :cli-arguments argv
- :setup (lambda (opts)
- (setf (gethash :strm opts) strm)
- opts)
- :teardown (lambda (result)
- (format strm "~A~%"
- (cl-i:generate-string result :pretty 4)
- )
- result)))
+ (cl-i:execute-program
+ "zippm"
+ (cl-i:system-environment-variables)
+ `(
+ (("athing") . ,#'athing)
+ )
+ :helps
+ `((("athing") . "A stub function"))
+ :cli-arguments argv
+ :setup (lambda (opts)
+ (setf (gethash :strm opts) strm)
+ opts)
+ :teardown (lambda (result)
+ (format strm "~A~%"
+ (cl-i:generate-string result :pretty 4)
+ )
+ result)))
(defun entrypoint (argv)
(uiop:quit
M src/resolve.lisp => src/resolve.lisp +195 -194
@@ 1,6 1,7 @@
;;;; This is a package for resolving package dependencies.
;;;; In the first part we have basic plumbing for dependency resolution;
;;;; the actual dependency resolving function is at the bottom.
+
#+(or)
(progn
(declaim (optimize (speed 0) (space 0) (debug 3)))
@@ 14,12 15,12 @@
(:import-from #:alexandria)
(:import-from #:cl-semver)
(:import-from #:esrap
- #:defrule
- #:character-ranges
- #:parse
- #:?)
+ #:defrule
+ #:character-ranges
+ #:parse
+ #:?)
(:export #:make-package-info
- #:package-info=))
+ #:package-info=))
(in-package #:skin.djha.zippm/resolve)
@@ 55,7 56,7 @@
(defmethod print-object ((obj version-predicate) strm)
(format strm "~a"
- (gethash (relation obj) relation-strings))
+ (gethash (relation obj) relation-strings))
(cl-semver:print-version (version obj) strm)
obj)
@@ 65,30 66,30 @@
(defclass package-info ()
((name :initarg :name
- :initform (error "a package name is required.")
- :type string
- :reader name)
+ :initform (error "a package name is required.")
+ :type string
+ :reader name)
(version :initarg :version
- :type cl-semver:semantic-version
- :initform (error "a package version is required.")
- :reader version)
+ :type cl-semver:semantic-version
+ :initform (error "a package version is required.")
+ :reader version)
(location :initarg :location
- :type string
- :initform (error "a package location is required.")
- :reader location)
+ :type string
+ :initform (error "a package location is required.")
+ :reader location)
(requirements :initarg :requirements
- :initform nil
- :type list ;; of lists of version requirements
- :reader requirements))
+ :initform nil
+ :type list ;; of lists of version requirements
+ :reader requirements))
(:documentation "a class to represent package information."))
(defmethod print-object ((obj package-info) strm)
(format strm "~a:"
- (name obj))
+ (name obj))
(cl-semver:print-version (version obj) strm)
(format strm "@~a(~{~{~a~^|~}~^&~})"
- (location obj)
- (requirements obj))
+ (location obj)
+ (requirements obj))
obj)
(deftype requirer ()
@@ 102,56 103,56 @@
(defclass requirement ()
((status :initarg :status
- :type requirement-status
- :reader status)
+ :type requirement-status
+ :reader status)
(name :initarg :name
- :type string
- :reader name)
+ :type string
+ :reader name)
(spec :initarg :spec
- :type list
- :reader spec)
+ :type list
+ :reader spec)
(requirer :initarg :requirer
- :type requirer
- :initform *requirer*
- :reader requirer))
+ :type requirer
+ :initform *requirer*
+ :reader requirer))
(:documentation "a package requirement."))
(defmethod print-object ((obj requirement) strm)
(format strm "~:[!~;~]~a~{~{~a~^,~}~^;~}"
- (eql :present (status obj))
- (name obj)
- (spec obj))
+ (eql :present (status obj))
+ (name obj)
+ (spec obj))
obj)
(defun decorate (requirement requirer)
(make-instance 'requirement
- :status (status requirement)
- :name (name requirement)
- :spec (spec requirement)
- :requirer requirer))
+ :status (status requirement)
+ :name (name requirement)
+ :spec (spec requirement)
+ :requirer requirer))
;; todo test
(defun make-package-info (name version location requirements)
(let* ((base-instance (make-instance 'package-info
- :name name
- :version version
- :location location))
- (*requirer* base-instance)
- (decorated-requirements
- (mapcar
- (lambda (conjunction)
- (mapcar
- (lambda (disjunction)
- (decorate disjunction base-instance))
- conjunction))
- requirements)))
+ :name name
+ :version version
+ :location location))
+ (*requirer* base-instance)
+ (decorated-requirements
+ (mapcar
+ (lambda (conjunction)
+ (mapcar
+ (lambda (disjunction)
+ (decorate disjunction base-instance))
+ conjunction))
+ requirements)))
(setf (slot-value base-instance 'requirements) decorated-requirements)
base-instance))
(defrule pess-greater "><"
- (:constant :pess-greater))
+ (:constant :pess-greater))
;;;; make sure I'm in good territory
;;;; with that one roswell bug.
@@ 160,122 161,122 @@
(defrule greater-equal ">="
- (:constant :greater-equal))
+ (:constant :greater-equal))
(defrule greater-than ">"
- (:constant :greater-than))
+ (:constant :greater-than))
(defrule matches "<>"
- (:constant :matches))
+ (:constant :matches))
(defrule less-equal "<="
- (:constant :less-equal))
+ (:constant :less-equal))
(defrule less-than "<"
- (:constant :less-than))
+ (:constant :less-than))
(defrule equal-to "=="
- (:constant :equal-to))
+ (:constant :equal-to))
(defrule not-equal "!="
- (:constant :not-equal))
+ (:constant :not-equal))
(defrule version-predicate
- (and
- (or
- pess-greater
- greater-equal
- greater-than
- matches
- less-equal
- less-than
- not-equal
- equal-to)
- cl-semver:version)
- (:destructure (relation version)
- (make-instance 'version-predicate :relation relation :version version)))
+ (and
+ (or
+ pess-greater
+ greater-equal
+ greater-than
+ matches
+ less-equal
+ less-than
+ not-equal
+ equal-to)
+ cl-semver:version)
+ (:destructure (relation version)
+ (make-instance 'version-predicate :relation relation :version version)))
(defrule vp-conjunction
- (and
- version-predicate
- (*
- (and
- #\,
- version-predicate)))
- (:destructure (vp others)
- (cons vp
- (loop for (_ vps) in others
- collect vps))))
+ (and
+ version-predicate
+ (*
+ (and
+ #\,
+ version-predicate)))
+ (:destructure (vp others)
+ (cons vp
+ (loop for (_ vps) in others
+ collect vps))))
(defrule vp-disjunction
- (and
- vp-conjunction
- (*
- (and
- #\;
- vp-conjunction)))
- (:destructure (vpc others)
- (cons vpc
- (loop for (_ vpcs) in others
- collect vpcs))))
+ (and
+ vp-conjunction
+ (*
+ (and
+ #\;
+ vp-conjunction)))
+ (:destructure (vpc others)
+ (cons vpc
+ (loop for (_ vpcs) in others
+ collect vpcs))))
(defrule package-name
- (+ (not (or #\: #\@ #\( #\) #\& #\| #\! #\, #\; #\> #\< #\=)))
- (:lambda (name)
- (coerce name 'string)))
+ (+ (not (or #\: #\@ #\( #\) #\& #\| #\! #\, #\; #\> #\< #\=)))
+ (:lambda (name)
+ (coerce name 'string)))
(defrule version-requirement
- (and
- (? #\!)
- package-name
- (? vp-disjunction))
- (:destructure (flag name spec)
- (make-instance
- 'requirement
- :status
- (if flag :absent :present)
- :name (coerce name 'string)
- :spec spec)))
+ (and
+ (? #\!)
+ package-name
+ (? vp-disjunction))
+ (:destructure (flag name spec)
+ (make-instance
+ 'requirement
+ :status
+ (if flag :absent :present)
+ :name (coerce name 'string)
+ :spec spec)))
(defrule vr-conjunction
- (and
- vr-disjunction
- (*
- (and
- #\&
- vr-disjunction)))
- (:destructure (vrc others)
- (cons vrc
- (loop for (_ vrcs) in others
- collect vrcs))))
+ (and
+ vr-disjunction
+ (*
+ (and
+ #\&
+ vr-disjunction)))
+ (:destructure (vrc others)
+ (cons vrc
+ (loop for (_ vrcs) in others
+ collect vrcs))))
(defrule vr-disjunction
- (and
- version-requirement
- (*
- (and
- #\|
- version-requirement)))
- (:destructure (vr others)
- (cons vr
- (loop for (_ vrs) in others
- collect vrs))))
+ (and
+ version-requirement
+ (*
+ (and
+ #\|
+ version-requirement)))
+ (:destructure (vr others)
+ (cons vr
+ (loop for (_ vrs) in others
+ collect vrs))))
(defrule package-info
- (and
- package-name
- #\:
- cl-semver:version
- #\@
- (+ (not #\())
- #\(
- (? vr-conjunction)
- #\)
- )
- (:destructure (name colon version at location open-paren requirements close-paren)
- (declare (ignore colon at open-paren close-paren))
- (make-package-info name version (coerce location 'string) requirements)))
+ (and
+ package-name
+ #\:
+ cl-semver:version
+ #\@
+ (+ (not #\())
+ #\(
+ (? vr-conjunction)
+ #\)
+ )
+ (:destructure (name colon version at location open-paren requirements close-paren)
+ (declare (ignore colon at open-paren close-paren))
+ (make-package-info name version (coerce location 'string) requirements)))
(defun version-predicate= (a b)
(declare (type version-predicate a b))
@@ 292,12 293,12 @@
(eql (status a) (status b))
(string= (name a) (name b))
(every (lambda (x y)
- (every (lambda (x y)
- (version-predicate= x y))
- x
- y))
- (spec a)
- (spec b))))
+ (every (lambda (x y)
+ (version-predicate= x y))
+ x
+ y))
+ (spec a)
+ (spec b))))
(defun package-info= (a b)
(declare (type package-info a b))
@@ 306,20 307,20 @@
(cl-semver:version= (version a) (version b))
(string= (location a) (location b))
(every (lambda (x y)
- (every (lambda (u v)
- (and (requirement= u v)
- (eq (requirer u) a)
- (eq (requirer v) b)))
- x
- y))
- (requirements a)
- (requirements b))))
+ (every (lambda (u v)
+ (and (requirement= u v)
+ (eq (requirer u) a)
+ (eq (requirer v) b)))
+ x
+ y))
+ (requirements a)
+ (requirements b))))
#+(or)
(progn
(multiple-value-bind (production position succeeded)
- (parse 'version-predicate ">=1.2.3")
+ (parse 'version-predicate ">=1.2.3")
(list production position succeeded))
(+ (parse 'version-predicate ">=1.2.3") 3)
(parse 'vp-disjunction ">=1.2.3,<=2.0.0,>=1.5.0;><3.0.0,!=3.2.3")
@@ 334,17 335,17 @@
;; elsewhere instead.
#+(or)
(make-instance 'package-info
- :name "foo"
- :version (cl-semver:read-version-from-string "1.2.3")
- :location "/tmp/foo"
- :requirements
- (list
- (list
- (parse 'version-requirement "bar>=1.2.3,<=2.0.0,>=1.5.0;><3.0.0,!=3.2.3")
- (parse 'version-requirement "il>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3"))
- (list
- (parse 'version-requirement "for>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3")
- (parse 'version-requirement "baz>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3"))))
+ :name "foo"
+ :version (cl-semver:read-version-from-string "1.2.3")
+ :location "/tmp/foo"
+ :requirements
+ (list
+ (list
+ (parse 'version-requirement "bar>=1.2.3,<=2.0.0,>=1.5.0;><3.0.0,!=3.2.3")
+ (parse 'version-requirement "il>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3"))
+ (list
+ (parse 'version-requirement "for>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3")
+ (parse 'version-requirement "baz>=1.2.3,<=2.0.0,=>1.5.0;><3.0.0,!=3.2.3"))))
(defun present (name &key spec)
(make-instance 'requirement :status :present :name name :spec spec))
@@ 355,7 356,7 @@
(defun version-passes (ver pred)
(declare (type cl-semver:semantic-version version)
- (type version-predicate pred))
+ (type version-predicate pred))
(case (relation pred)
(:greater-than (cl-semver:version> ver (version pred)))
(:greater-equal (cl-semver:version>= ver (version pred)))
@@ 364,45 365,45 @@
(:less-equal (cl-semver:version<= ver (version pred)))
(:less-than (cl-semver:version< ver (version pred)))
(:pess-greater (and
- (cl-semver:version>= ver (version pred))
- (cl-semver:version<
- ver
- (cl-semver:make-semantic-version
- (1+ (cl-semver:version-major (version pred))) 0 0))))))
+ (cl-semver:version>= ver (version pred))
+ (cl-semver:version<
+ ver
+ (cl-semver:make-semantic-version
+ (1+ (cl-semver:version-major (version pred))) 0 0))))))
;(defun requirement-fulfills (req pkg)
- ; (declare (type requirement req)
- ; (type package-info pkg))
- ; (and
- ; (eql (status requirement) :present)
- ; (string= (name requirement) (name package))
- ; (every (lambda (spec)
- ; (some (lambda (predicate)
- ; (cl-semver:satisfies? (version package) predicate))
- ; spec))
- ; (spec requirement))))
+; (declare (type requirement req)
+; (type package-info pkg))
+; (and
+; (eql (status requirement) :present)
+; (string= (name requirement) (name package))
+; (every (lambda (spec)
+; (some (lambda (predicate)
+; (cl-semver:satisfies? (version package) predicate))
+; spec))
+; (spec requirement))))
;
; (with-slots (name version requirements) package
- ; (if (string= (name requirement) name)
- ; (every (lambda (spec)
- ; (some (lambda (predicate)
- ; (cl-semver:satisfies? version predicate))
- ; spec))
- ; (spec requirement))
- ; nil)))
+; (if (string= (name requirement) name)
+; (every (lambda (spec)
+; (some (lambda (predicate)
+; (cl-semver:satisfies? version predicate))
+; spec))
+; (spec requirement))
+; nil)))
; (let ((name (name package))
; (version (version package))
; (requirements (requirements package)))
- ; (if (string= (name requirement) name)
- ; (every (lambda (spec)
- ; (some (lambda (predicate)
- ; (cl-semver:satisfies? version predicate))
- ; spec))
- ; (spec requirement))
- ; nil)))
+; (if (string= (name requirement) name)
+; (every (lambda (spec)
+; (some (lambda (predicate)
+; (cl-semver:satisfies? version predicate))
+; spec))
+; (spec requirement))
+; nil)))
;
;
;
;
;(defgeneric fulfills (requirement package)
- ; (:documentation "A generic function to determine if a package fulfills a requirement."))
+; (:documentation "A generic function to determine if a package fulfills a requirement."))
M tests/resolve.lisp => tests/resolve.lisp +140 -151
@@ 1,42 1,31 @@
-
#+(or)
(progn
- (ql:quickload "parachute")
- (ql:quickload "quri")
- (ql:quickload "cl-semver")
- (ql:quickload "alexandria")
- (ql:quickload "dexador")
- (ql:quickload "trivial-package-local-nicknames")
- (asdf:load-system "skin.djha.zippm")
- (asdf:test-system "skin.djha.zippm")
- )
+ (asdf:load-system "skin.djha.zippm")
+ (asdf:test-system "skin.djha.zippm"))
(defpackage #:skin.djha.zippm/tests/resolve
- (:use #:cl
- #:parachute
- )
- (:import-from
- #:skin.djha.zippm/resolve)
+ (:use #:cl)
+ (:import-from
+ #:skin.djha.zippm/resolve)
(:import-from
- #:cl-semver)
+ #:cl-semver)
(:import-from
- #:org.shirakumo.parachute
- #:define-test
- #:true
- #:false
- #:fail
- #:is
- #:isnt
- #:is-values
- #:isnt-values
- #:of-type
- #:finish
- #:test)
+ #:org.shirakumo.parachute
+ #:define-test
+ #:true
+ #:false
+ #:fail
+ #:is
+ #:isnt
+ #:is-values
+ #:isnt-values
+ #:of-type
+ #:finish
+ #:test)
(:import-from #:esrap)
(:local-nicknames
- (#:parachute #:org.shirakumo.parachute)
- (#:resolve #:skin.djha.zippm/resolve))
- )
+ (#:parachute #:org.shirakumo.parachute)
+ (#:resolve #:skin.djha.zippm/resolve)))
(in-package #:skin.djha.zippm/tests/resolve)
@@ 51,135 40,135 @@
(define-test basic-structures)
(defparameter +over1+ (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :greater-equal
- :version #v"1.0"))
+ :relation :greater-equal
+ :version #v"1.0"))
(defparameter +under2+ (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :less-than
- :version #v"2.0"))
+ :relation :less-than
+ :version #v"2.0"))
(defparameter +at23+ (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :equal-to
- :version #v"2.3"))
+ :relation :equal-to
+ :version #v"2.3"))
(defparameter +present-r+ (make-instance 'skin.djha.zippm/resolve::requirement
- :status :present
- :name "foo"
- :spec
- `(
- (,+over1+ ,+under2+)
- (,+at23+))))
+ :status :present
+ :name "foo"
+ :spec
+ `(
+ (,+over1+ ,+under2+)
+ (,+at23+))))
(define-test "Make a version predicate"
- :parent basic-structures
- (is string= (format nil "~A" +over1+) ">=1.0.0")
- (is string= (format nil "~A" +under2+) "<2.0.0")
- (is string= (format nil "~A" +at23+) "==2.3.0")
- (is string= (format nil "~A" +present-r+) "foo>=1.0.0,<2.0.0;==2.3.0"))
+ :parent basic-structures
+ (is string= (format nil "~A" +over1+) ">=1.0.0")
+ (is string= (format nil "~A" +under2+) "<2.0.0")
+ (is string= (format nil "~A" +at23+) "==2.3.0")
+ (is string= (format nil "~A" +present-r+) "foo>=1.0.0,<2.0.0;==2.3.0"))
(define-test "Make a package information object"
- :parent basic-structures
- ;; TODO: Make tests use the parse stuff
- (let ((pio
- (resolve:make-package-info "seven-bros" (cl-semver:read-version-from-string "1.2.3") "/tmp/foo"
- (list
- (list
- (make-instance 'resolve::requirement
- :status :present
- :name "adam"
- :spec
- (list
- (list
- (make-instance 'resolve::version-predicate
- :relation :greater-equal
- :version (cl-semver:read-version-from-string "1.2.3"))
- (make-instance 'resolve::version-predicate
- :relation :less-equal
- :version (cl-semver:read-version-from-string "1.9.7"))
- (make-instance 'resolve::version-predicate
- :relation :not-equal
- :version (cl-semver:read-version-from-string "1.5.0"))
- )
- (list
- (make-instance 'resolve::version-predicate
- :relation :pess-greater
- :version (cl-semver:read-version-from-string "3.0.0"))
- )
- )
- )
- (make-instance 'resolve::requirement
- :status :present
- :name "benjamin"
- :spec
- (list
- (list
- (make-instance 'resolve::version-predicate
- :relation :equal-to
- :version (cl-semver:read-version-from-string "89.1.0")))
- (list
- (make-instance 'resolve::version-predicate
- :relation :equal-to
- :version (cl-semver:read-version-from-string "89.5.0")))
- (list
- (make-instance 'resolve::version-predicate
- :relation :equal-to
- :version (cl-semver:read-version-from-string "94.1.0")))))
- )
- (list
- (make-instance 'resolve::requirement
- :status :absent
- :name "caleb"
- :spec nil)
- (make-instance 'resolve::requirement
- :status :present
- :name "caleb"
- :spec
- (list
- (list
- (make-instance 'resolve::version-predicate
- :relation :greater-equal
- :version (cl-semver:read-version-from-string "5.0.0-alpha.3"))
- (make-instance 'resolve::version-predicate
- :relation :less-than
- :version (cl-semver:read-version-from-string "5.0.0"))
- )
- )
- ))
- (list
- (make-instance 'resolve::requirement
- :status :present
- :name "daniel"
- :spec
- nil
- )))))
- (pio-string "seven-bros:1.2.3@/tmp/foo(adam>=1.2.3,<=1.9.7,!=1.5.0;><3.0.0|benjamin==89.1.0;==89.5.0;==94.1.0&!caleb|caleb>=5.0.0-alpha.3,<5.0.0&daniel)"))
- (true (string= (format nil "~A" pio)
- pio-string))
- (true (resolve:package-info= (esrap:parse 'resolve::package-info pio-string)
- pio))
- (true (string= (format nil "~A" (esrap:parse 'resolve::package-info pio-string))
- pio-string))))
+ :parent basic-structures
+ ;; TODO: Make tests use the parse stuff
+ (let ((pio
+ (resolve:make-package-info "seven-bros" (cl-semver:read-version-from-string "1.2.3") "/tmp/foo"
+ (list
+ (list
+ (make-instance 'resolve::requirement
+ :status :present
+ :name "adam"
+ :spec
+ (list
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :greater-equal
+ :version (cl-semver:read-version-from-string "1.2.3"))
+ (make-instance 'resolve::version-predicate
+ :relation :less-equal
+ :version (cl-semver:read-version-from-string "1.9.7"))
+ (make-instance 'resolve::version-predicate
+ :relation :not-equal
+ :version (cl-semver:read-version-from-string "1.5.0"))
+ )
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :pess-greater
+ :version (cl-semver:read-version-from-string "3.0.0"))
+ )
+ )
+ )
+ (make-instance 'resolve::requirement
+ :status :present
+ :name "benjamin"
+ :spec
+ (list
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :equal-to
+ :version (cl-semver:read-version-from-string "89.1.0")))
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :equal-to
+ :version (cl-semver:read-version-from-string "89.5.0")))
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :equal-to
+ :version (cl-semver:read-version-from-string "94.1.0")))))
+ )
+ (list
+ (make-instance 'resolve::requirement
+ :status :absent
+ :name "caleb"
+ :spec nil)
+ (make-instance 'resolve::requirement
+ :status :present
+ :name "caleb"
+ :spec
+ (list
+ (list
+ (make-instance 'resolve::version-predicate
+ :relation :greater-equal
+ :version (cl-semver:read-version-from-string "5.0.0-alpha.3"))
+ (make-instance 'resolve::version-predicate
+ :relation :less-than
+ :version (cl-semver:read-version-from-string "5.0.0"))
+ )
+ )
+ ))
+ (list
+ (make-instance 'resolve::requirement
+ :status :present
+ :name "daniel"
+ :spec
+ nil
+ )))))
+ (pio-string "seven-bros:1.2.3@/tmp/foo(adam>=1.2.3,<=1.9.7,!=1.5.0;><3.0.0|benjamin==89.1.0;==89.5.0;==94.1.0&!caleb|caleb>=5.0.0-alpha.3,<5.0.0&daniel)"))
+ (true (string= (format nil "~A" pio)
+ pio-string))
+ (true (resolve:package-info= (esrap:parse 'resolve::package-info pio-string)
+ pio))
+ (true (string= (format nil "~A" (esrap:parse 'resolve::package-info pio-string))
+ pio-string))))
(define-test fulfillments)
(define-test "version passes"
- :parent fulfillments
- (let ((p (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :greater-equal
- :version #v"2.0"))
- (q (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :less-than
- :version #v"3.0"))
- (s (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :equal-to
- :version #v"3.3"))
- (u (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :pess-greater
- :version #v"2.0"))
- (w (make-instance 'skin.djha.zippm/resolve::version-predicate
- :relation :pess-greater
- :version #v"1.0"))
- (v #v"2.5"))
- (true (resolve::version-passes v p))
- (true (resolve::version-passes v q))
- (true (not (resolve::version-passes v s)))
- (true (resolve::version-passes v u))
- (true (not (resolve::version-passes v w)))))
+ :parent fulfillments
+ (let ((p (make-instance 'skin.djha.zippm/resolve::version-predicate
+ :relation :greater-equal
+ :version #v"2.0"))
+ (q (make-instance 'skin.djha.zippm/resolve::version-predicate
+ :relation :less-than
+ :version #v"3.0"))
+ (s (make-instance 'skin.djha.zippm/resolve::version-predicate
+ :relation :equal-to
+ :version #v"3.3"))
+ (u (make-instance 'skin.djha.zippm/resolve::version-predicate
+ :relation :pess-greater
+ :version #v"2.0"))
+ (w (make-instance 'skin.djha.zippm/resolve::version-predicate
+ :relation :pess-greater
+ :version #v"1.0"))
+ (v #v"2.5"))
+ (true (resolve::version-passes v p))
+ (true (resolve::version-passes v q))
+ (true (not (resolve::version-passes v s)))
+ (true (resolve::version-passes v u))
+ (true (not (resolve::version-passes v w)))))