~skin/zippm

e85a676d80602ec9fcfeeee0abeb7bc8cbbb6791 — Daniel Jay Haskin 6 months ago cbd311c
Add run-tests script, completely on parachute, time to move on.
7 files changed, 216 insertions(+), 178 deletions(-)

D scripts/format.ros
M scripts/nvim-format.ros
A scripts/run-tests.ros
M skin.djha.zippm.asd
M src/resolve.lisp
A tests/main.lisp
M tests/resolve.lisp
D scripts/format.ros => scripts/format.ros +0 -46
@@ 1,46 0,0 @@
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp
  (ql:quickload '("cl-arrows") :silent t)
  )

(defpackage :ros.script.format.3918404214
  (:use :cl
        :cl-arrows))

(in-package :ros.script.format.3918404214)

(defun lisp-files (dir)
  (->> dir
       (uiop/filesystem:directory-files)
       (remove-if-not (lambda (x) (string= (pathname-type x) "lisp")))))

(defun main (&rest argv)
  (declare (ignorable argv))
   (let ((flag-file (probe-file "./skin.djha.zippm.asd")))
     (when (not flag-file)
       (error "This script must be run from the root of the project."))
     (let* ((root-path (uiop/os:getcwd))
            (format-files
              (concatenate 'list
                           (lisp-files (merge-pathnames "./src/" root-path))
                           (lisp-files (merge-pathnames "./tests/" root-path))
                           '("skin.djha.zippm.asd"
                           "zippm.ros"))))
       (loop for file in format-files
             do
             (uiop:run-program
               `("nvim"
                 "-es"
                 "-c"
                 "normal gg=G"
                 "-c"
                 "wq"
                 ,file))))))

;;; vim: set ft=lisp lisp:

M scripts/nvim-format.ros => scripts/nvim-format.ros +13 -13
@@ 20,20 20,14 @@ exec ros -Q -- $0 "$@"
       (uiop/filesystem:directory-files)
       (remove-if-not (lambda (x) (string= (pathname-type x) "lisp")))))

(defun main (&rest argv)
  (declare (ignorable argv))
   (let ((flag-file (probe-file "./skin.djha.zippm.asd")))
     (when (not flag-file)
       (format *error-output* "We are not in a git repository~%")
       (uiop:quit 1))
     (let* ((root-path (uiop/os:getcwd))
            (format-files
(defun format-files (root-path)
    (let ((to-do
              (concatenate 'list
                           (lisp-files (merge-pathnames "./src/" root-path))
                           (lisp-files (merge-pathnames "./tests/" root-path))
                           '("skin.djha.zippm.asd"
                           "zippm.ros"))))
       (loop for file in format-files
       (loop for file in to-do
             do
             (uiop:run-program
               `("nvim"


@@ 42,8 36,14 @@ exec ros -Q -- $0 "$@"
                 "normal gg=G"
                 "-c"
                 "wq"
                 ,(namestring
                   (pathname-name file))))))))
#+(or)
(main)
                 ,(namestring file))))))

(defun main (&rest argv)
  (declare (ignorable argv))
   (let ((flag-file (probe-file "./skin.djha.zippm.asd")))
     (when (not flag-file)
       (format *error-output* "We are not in a git repository~%")
       (uiop:quit 1))
     (let ((root-path (uiop/os:getcwd)))
       (format-files root-path))))
;;; vim: set ft=lisp lisp:

A scripts/run-tests.ros => scripts/run-tests.ros +19 -0
@@ 0,0 1,19 @@
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp(ql:quickload '() :silent t)
  )

(defpackage :ros.script.run-tests.3918409813
  (:use :cl))
(in-package :ros.script.run-tests.3918409813)

(defun main (&rest argv)
  (declare (ignorable argv))
  (asdf:test-system "skin.djha.zippm"))

;;; vim: set ft=lisp lisp:

M skin.djha.zippm.asd => skin.djha.zippm.asd +12 -10
@@ 2,18 2,16 @@
	   :version "0.1.0"
	   :author "Daniel Jay Haskin"
	   :license "MIT"
	   :depends-on (
			"cl-i"
	   :depends-on ("cl-i"
			"esrap"
			"cl-semver"
			"alexandria"
			)
			"alexandria")
	   :components ((:module "src"
				 :components
				 ((:file "main")
				  (:file "resolve"))))
	   :description ""
	   :in-order-to ((test-op (test-op "skin.djha.zippm/tests"))))
	   :in-order-to ((asdf:test-op (asdf:test-op "skin.djha.zippm/tests"))))

(defsystem "skin.djha.zippm/tests"
	   :author "Daniel Jay Haskin"


@@ 23,9 21,13 @@
			"parachute")
	   :components ((:module "tests"
				 :components
				 ((:file "resolve"))))
				 ((:file "main")
				  (:file "resolve"))))
	   :description "Test system for zippm"
	   :perform (test-op (op c)
			     (uiop:symbol-call
			       :parachute
			       :test #:skin.djha.zippm/tests/resolve)))
	   :perform (asdf:test-op (op c)
				  (uiop:symbol-call
				    :parachute
				    :test :skin.djha.zippm/tests)
				  (uiop:symbol-call
				    :parachute
				    :test :skin.djha.zippm/tests/resolve)))

M src/resolve.lisp => src/resolve.lisp +2 -1
@@ 5,7 5,8 @@
#+(or)
(progn
  (declaim (optimize (speed 0) (space 0) (debug 3)))
  (asdf:load-system "skin.djha.zippm/resolve")
  (asdf:load-system "skin.djha.zippm")
  (asdf:test-system "skin.djha.zippm")
  (dolist (x '("uiop" "alexandria" "cl-semver" "esrap"))
    (asdf:load-system x)))


A tests/main.lisp => tests/main.lisp +25 -0
@@ 0,0 1,25 @@
(defpackage :skin.djha.zippm/tests
  (:use #:cl)
  (:import-from
    #:skin.djha.zippm)
  (:import-from
    #: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)
    (#:zippm #:skin.djha.zippm)))

(in-package #:skin.djha.zippm/tests)

(define-test main)

M tests/resolve.lisp => tests/resolve.lisp +145 -108
@@ 3,7 3,7 @@
  (asdf:load-system "skin.djha.zippm")
  (asdf:test-system "skin.djha.zippm"))

(defpackage #:skin.djha.zippm/tests/resolve
(defpackage :skin.djha.zippm/tests/resolve
  (:use #:cl)
  (:import-from
    #:skin.djha.zippm/resolve)


@@ 30,13 30,10 @@
(in-package #:skin.djha.zippm/tests/resolve)

;; NOTE: To run this test file, execute `(asdf:test-system :zippm)' in your Lisp.
+(or)
(test *)

(cl-semver:enable-version-syntax)

;; TODO: Get tests in for 

;; TODO: Get tests in for
(define-test basic-structures)

(defparameter +over1+ (make-instance 'skin.djha.zippm/resolve::version-predicate


@@ 64,111 61,151 @@
	     (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))))
(defparameter
  +seven-bros+
  (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)))))

(defparameter +seven-bros-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)")

(define-test
  "Make a package information object"
  :parent basic-structures
  ;; TODO: Make tests use the parse stuff
  (is string= (format nil "~A" +seven-bros+)
		 +seven-bros-string+)
  (is resolve:package-info=
	  (esrap:parse 'resolve::package-info +seven-bros-string+)
	  +seven-bros+)
  (is string=
	  (format nil "~A"
		  (esrap:parse
		    'resolve::package-info
		    +seven-bros-string+))
	  +seven-bros-string+))

(define-test fulfillments)

(defparameter +past-2+
  (make-instance 'skin.djha.zippm/resolve::version-predicate
		 :relation :greater-equal
		 :version #v"2.0"))

(defparameter +under-3+
  (make-instance 'skin.djha.zippm/resolve::version-predicate
		 :relation :less-than
		 :version #v"3.0"))

(defparameter +at-3.3+
  (make-instance 'skin.djha.zippm/resolve::version-predicate
		 :relation :equal-to
		 :version #v"3.3"))

(defparameter +between-2-3+
  (make-instance 'skin.djha.zippm/resolve::version-predicate
		 :relation :pess-greater
		 :version #v"2.0"))

(defparameter +between-1-2+
  (make-instance 'skin.djha.zippm/resolve::version-predicate
		 :relation :pess-greater
		 :version #v"1.0"))

(defparameter +version-2.5+ #v"2.5")

(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)))))
	     (true (resolve::version-passes +version-2.5+ +past-2+))
	     (true (resolve::version-passes +version-2.5+ +under-3+))
	     (false (resolve::version-passes +version-2.5+ +at-3.3+))
	     (true (resolve::version-passes +version-2.5+ +between-2-3+))
	     (false (resolve::version-passes +version-2.5+ +between-1-2+)))