changeset 355: |
09f056e9a789 |
parent 354: |
aeef48e62bc0 |
child 356: |
aac665e2f5bf |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Tue, 14 May 2024 18:33:03 -0400 |
files: |
lisp/bin/homer.lisp lisp/std/pkg.lisp lisp/std/tests.lisp x.lisp |
description: |
bugfixes, x test |
1.1--- a/lisp/bin/homer.lisp Tue May 14 16:44:11 2024 -0400
1.2+++ b/lisp/bin/homer.lisp Tue May 14 18:33:03 2024 -0400
1.3@@ -13,7 +13,7 @@
1.4 (declaim (type home-config *home-config*))
1.5 (defvar *home-config*)
1.6 (defvar *home-hidden-paths* (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))
1.7-
1.8+(defvar *homer-force* nil)
1.9 (defclass home-config (sxp id)
1.10 ((user :initform *user* :initarg :user :type string)
1.11 (path :initform nil :initarg :path :type (or pathname null))
1.12@@ -72,11 +72,13 @@
1.13 (defopt homer-help (print-help $cli))
1.14 (defopt homer-version (print-version $cli))
1.15 (defopt homer-log-level (when $val (setq *log-level* :debug)))
1.16+(defopt homer-force (when $val (setq *homer-force* t)))
1.17
1.18 (defcmd homer-show
1.19 (describe *home-config*))
1.20
1.21 (defun mtime (path) (sb-posix:stat-mtime (sb-posix:stat path)))
1.22+(defun ctime (path) (sb-posix:stat-ctime (sb-posix:stat path)))
1.23
1.24 (defun compare-home-file (src)
1.25 "Compare a SRC path to what is stored in the user's home. Return a cons with
1.26@@ -88,7 +90,8 @@
1.27 (status (cond
1.28 ((null m2) :new)
1.29 ((> m1 m2) :pull)
1.30- ((< m1 m2) :push)
1.31+ ((< m1 m2) (unless (= (ctime home) m2)
1.32+ :push))
1.33 (t))))
1.34 (cons status (cons src home))))
1.35
1.36@@ -140,7 +143,11 @@
1.37 (:new (progn
1.38 (println (format nil ":NEW ~A" (cddr form)))
1.39 (homer-copy (cadr form) (cddr form))))
1.40- (:push (warn! "skipping file:" (cddr form)))
1.41+ (:push (if *homer-force*
1.42+ (progn
1.43+ (println (format nil ":OVERWRITE ~A" (cddr form)))
1.44+ (homer-copy (cadr form) (cddr form)))
1.45+ (trace! "skipping file:" (cddr form))))
1.46 (t nil))))
1.47
1.48 (defcmd homer-push
1.49@@ -171,11 +178,12 @@
1.50 :name "homer"
1.51 :version "0.1.0"
1.52 :description "user home manager"
1.53- :thunk homer-show
1.54+ :thunk homer-check
1.55 :opts (make-opts
1.56 (:name "level" :global t :description "set the log level" :thunk homer-log-level)
1.57 (:name "help" :global t :description "print help" :thunk homer-help)
1.58- (:name "version" :global t :description "print version" :thunk homer-version))
1.59+ (:name "version" :global t :description "print version" :thunk homer-version)
1.60+ (:name "force" :global t :description "use force" :thunk homer-force))
1.61 :cmds (make-cmds
1.62 (:name show :thunk homer-show)
1.63 (:name check :thunk homer-check)
2.1--- a/lisp/std/pkg.lisp Tue May 14 16:44:11 2024 -0400
2.2+++ b/lisp/std/pkg.lisp Tue May 14 18:33:03 2024 -0400
2.3@@ -183,23 +183,6 @@
2.4 :task-pool-oracle :task-pool-jobs :task-pool-stages
2.5 :task-pool-workers :task-pool-results))
2.6
2.7-(defpkg :std/readtable
2.8- (:use :cl)
2.9- (:import-from :std/named-readtables :defreadtable)
2.10- (:import-from :std/sym :symb)
2.11- (:import-from :std/list :defmacro!) ;; kludge
2.12- (:export
2.13- ;; readtable
2.14- :|#"-reader|
2.15- :|#`-reader|
2.16- :|#f-reader|
2.17- :|#$-reader|
2.18- :segment-reader
2.19- :match-mode-ppcre-lambda-form
2.20- :subst-mode-ppcre-lambda-form
2.21- :|#~-reader|
2.22- :_))
2.23-
2.24 (defpkg :std/macs
2.25 (:use :cl)
2.26 (:import-from :std/sym :symb :mkstr :make-gensym-list :once-only :with-gensyms)
2.27@@ -278,6 +261,24 @@
2.28 :curry
2.29 :rcurry))
2.30
2.31+(defpkg :std/readtable
2.32+ (:use :cl)
2.33+ (:import-from :std/named-readtables :defreadtable)
2.34+ (:import-from :std/fu :curry :rcurry :compose)
2.35+ (:import-from :std/sym :symb)
2.36+ (:import-from :std/list :defmacro!) ;; kludge
2.37+ (:export
2.38+ ;; readtable
2.39+ :|#"-reader|
2.40+ :|#`-reader|
2.41+ :|#f-reader|
2.42+ :|#$-reader|
2.43+ :segment-reader
2.44+ :match-mode-ppcre-lambda-form
2.45+ :subst-mode-ppcre-lambda-form
2.46+ :|#~-reader|
2.47+ :_))
2.48+
2.49 (defpkg :std/bit
2.50 (:use :cl)
2.51 (:import-from :std/type :octet :octet-vector)
3.1--- a/lisp/std/tests.lisp Tue May 14 16:44:11 2024 -0400
3.2+++ b/lisp/std/tests.lisp Tue May 14 18:33:03 2024 -0400
3.3@@ -7,7 +7,7 @@
3.4 ;;; Code:
3.5 (in-package :std-user)
3.6 (defpkg :std/tests
3.7- (:use :cl :std :rt :sb-thread))
3.8+ (:use :cl :std :rt :sb-thread :std/fu))
3.9 (in-package :std/tests)
3.10 (defsuite :std)
3.11 (in-suite :std)
3.12@@ -15,7 +15,8 @@
3.13 ;; prevent threadlocks
3.14 ;; (setf sb-unix::*on-dangerous-wait* :error)
3.15
3.16-(deftest readtables ()
3.17+;; TODO 2024-05-14: fix compilation order of std/fu vs std/readtables
3.18+(deftest readtables (:disabled nil)
3.19 "Test :std readtable"
3.20 (is (typep #`(,a1 ,a1 ',a1 ,@a1) 'function))
3.21 (is (string= #"test "foo" "# "test \"foo\" "))
3.22@@ -179,10 +180,10 @@
3.23 (is (= 3 (acond ((1+ 1) (1+ it)))))
3.24 (loop for x in '(1 2 3)
3.25 for y in (funcall (alet ((a 1) (b 2) (c 3))
3.26- (lambda () (mapc #'1+ (list a b c)))))
3.27+ (lambda () (mapc #'1+ (list a b c)))))
3.28 collect (is (= x y))))
3.29
3.30-(deftest pan ()
3.31+(deftest pan (:disabled t)
3.32 "Test standard pandoric macros"
3.33 (let ((p
3.34 (plambda (a) (b c)
3.35@@ -241,14 +242,13 @@
3.36 x) ;; 2
3.37 '(42 42 2)))))
3.38
3.39-(deftest bits (:disabled nil)
3.40- (eval-always
3.41- (define-bitfield testbits
3.42- (a boolean)
3.43- (b (signed-byte 2))
3.44- (c (unsigned-byte 3) :initform 1)
3.45- (d (integer -100 100))
3.46- (e (member foo bar baz))))
3.47+(deftest bits (:disabled t)
3.48+ (define-bitfield testbits
3.49+ (a boolean)
3.50+ (b (signed-byte 2))
3.51+ (c (unsigned-byte 3) :initform 1)
3.52+ (d (integer -100 100))
3.53+ (e (member foo bar baz)))
3.54 (let ((bits (make-testbits)))
3.55 (is (not (testbits-a bits)))
3.56 (is (= 0 (testbits-b bits)))
4.1--- a/x.lisp Tue May 14 16:44:11 2024 -0400
4.2+++ b/x.lisp Tue May 14 18:33:03 2024 -0400
4.3@@ -21,7 +21,7 @@
4.4 ;; (asdf:load-asd (probe-file #P"ext/cl-ppcre.asd"))
4.5 )
4.6
4.7-(asdf:load-asd (probe-file (merge-pathnames "std.asd" "lisp/std/std.asd")))
4.8+(asdf:load-asd (probe-file (merge-pathnames "std.asd" "lisp/std/")))
4.9 (asdf:load-system :std)
4.10
4.11 (defpackage :x
4.12@@ -111,6 +111,7 @@
4.13 test
4.14 compile
4.15 build
4.16+test
4.17 run
4.18 save
4.19 install")))
4.20@@ -178,12 +179,17 @@
4.21 ;; self save
4.22 (sb-ext:run-program "x.lisp" nil :input t :output t)))
4.23
4.24+(asdf:load-asd (probe-file (merge-pathnames "log.asd" "lisp/lib/log/")))
4.25+(asdf:load-asd (probe-file (merge-pathnames "rt.asd" "lisp/lib/rt/")))
4.26+(asdf:load-system :log)
4.27+(asdf:load-system :rt)
4.28+(ql:quickload :rt)
4.29+
4.30 (defun x-test (args)
4.31 (if args
4.32 (let ((name (car args)))
4.33- (ql:quickload name)
4.34- (ql:quickload (format nil "~A/TESTS" name))
4.35- (ignore-some-conditions (warning) (asdf:test-system name)))
4.36+ (ql:quickload (string-upcase (format nil "~A/tests" name)))
4.37+ (rt:do-tests (string-upcase name) t))
4.38 (bail "missing arg")))
4.39
4.40 (defun x-run (args)