Skip to content
Snippets Groups Projects
Commit f242502f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Miscellaneous small fixes.

parent 4c392b26
No related branches found
No related tags found
No related merge requests found
......@@ -166,7 +166,7 @@ where KEYWORD defaults to :ARG and SUPPLIED-P defaults to ARG."
(kw (if (and (consp ks) (consp (car ks))) (caar ks)
(conc-keyword key)))
(suppliedp (if (and (listp ks) (<= 2 (length ks))) (second ks)
(conc-symbol key :-supplied-p)))
key #|(conc-symbol key :-supplied-p)|#))
(if-supplied (if (and (listp ks) (<= 3 (length ks)))
(third ks)
key)))
......
......@@ -240,8 +240,11 @@ outputs a tag plus a list of variable and their values, returns the last value"
exprs)
(apply 'values ,res)))))
(defun package-functions (package-designator)
(loop :for s :being :each :present-symbol :of package-designator
:when (and (fboundp s) (not (macro-function s))) :collect s))
(loop :with p = (find-package package-designator)
:for s :being :each :present-symbol :of p
:when (and (eq p (symbol-package s))
(fboundp s) (not (macro-function s)))
:collect s))
(defun trace-package-functions (package-designator)
(eval `(trace ,@(package-functions package-designator))))
(defun untrace-package-functions (package-designator)
......
......@@ -168,7 +168,7 @@
(defun featurify (bool)
(if #+common-lisp bool #-common-lisp (not bool)
'common-lisp '(not common-lisp)))
':common-lisp '(:not :common-lisp)))
(defun unfeaturify (bool-feature)
(equal bool-feature (featurify t)))))
......
......@@ -4,7 +4,7 @@
(in-package :fare-utils)
;;; File replacement function
;;; File replacement functions
(defun clobber-file-with-vector (file vector &key (external-format :default))
(with-open-file (s file
:direction :output
......
......@@ -78,10 +78,9 @@ TODO:
(defmethod insert-item! ((container doubly-linked-list) item)
;; insert item as the next
(with-slots (next) container
(let ((new (make-instance 'doubly-linked-list-node :content item)))
(join-dl-chains new new (doubly-linked-next container) container)
new)))
(let ((new (make-instance 'doubly-linked-list-node :content item)))
(join-dl-chains new new (doubly-linked-next container) container)
new))
(defmethod pop-item! ((container doubly-linked-list))
(let* ((next (doubly-linked-next container)))
......
#+xcvb
(module
(:depends-on
("package"
"strings"
"functional-map"
"updatef")
:build-depends-on ((:build "/fare-utils") (:asdf "hu.dwim.stefil"))
:supersedes-asdf ("fare-utils-test")))
#+xcvb (module (:depends-on ("package")))
(in-package :fare-utils-test)
(declaim (optimize (speed 1) (debug 3) (space 3)))
......
#+xcvb (module ())
(defpackage :fare-utils-test
(:use :fare-utils :interface :eq :order :pure :cl :hu.dwim.stefil))
#+xcvb (module (:depends-on ("package")))
(in-package :fare-utils-test)
(defsuite* (test-strings
......@@ -8,5 +9,5 @@
(is (equal (strcat "foo" "bar" "baz") "foobarbaz")))
(deftest test-join-strings ()
(is (equal (join-strings ":" '("/bin" "/usr/bin" "/usr/local/bin"))
(is (equal (join-strings '("/bin" "/usr/bin" "/usr/local/bin") :separator ":")
"/bin:/usr/bin:/usr/local/bin")))
#+xcvb (module (:depends-on ("package")))
(in-package :fare-utils-test)
(declaim (optimize (speed 1) (debug 3) (space 3)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment