#+allegro
- (multiple-value-bind (output dummy pid)
- (excl:run-shell-command command :input nil :output :stream
- :wait nil)
- (declare (ignore dummy))
- (values output pid))
+ (excl:run-shell-command command :input nil :output nil
+ :wait t)
#+lispworks
(system:call-system-showing-output
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (char= #\a (schar (symbol-name '#:a) 0))
- (pushnew :lowercase-reader *features*)))
+ (pushnew :lowercase-reader *features*))
+ (when (not (eql '#:a '#:A))
+ (pushnew :case-sensitive *features*)))
(defun string-default-case (str)
- #+(and (not case-sensitive) (not lowercase-reader))
- (string-upcase str)
- #+(and (not case-sensitive) lowercase-reader)
- (string-downcase str)
- #+case-sensitive
- str)
+ #-lowercase-reader
+ (string-upcase str)
+ #+lowercase-reader
+ (string-downcase str))
(defun concat-symbol-pkg (pkg &rest args)
(declare (dynamic-extent args))
(symbol
(symbol-name arg)))))
(let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
- (intern (string-default-case str)
- (if pkg pkg *package*)))))
+ (nth-value 0 (intern (string-default-case str)
+ (if pkg pkg *package*))))))
(defun concat-symbol (&rest args)
"Returns keyword for a name"
(etypecase name
(keyword name)
- (string (intern (string-default-case name) :keyword))
- (symbol (intern (symbol-name name) :keyword))))
+ (string (nth-value 0 (intern (string-default-case name) :keyword)))
+ (symbol (nth-value 0 (intern (symbol-name name) :keyword)))))
(defun ensure-keyword-upcase (desig)
- (intern (string-upcase (symbol-name (ensure-keyword desig))) :keyword))
+ (nth-value 0 (intern (string-upcase
+ (symbol-name (ensure-keyword desig))) :keyword)))
(defun ensure-keyword-default-case (desig)
- (intern (string-default-case (symbol-name (ensure-keyword desig))) :keyword))
+ (nth-value 0 (intern (string-default-case
+ (symbol-name (ensure-keyword desig))) :keyword)))
(defun show (&optional (what :variables) (package *package*))
(ecase what
:value-range 0.05 :saturation-range 0
:black-limit 0 :gray-limit .1) nil)
+#+ignore
+(progn
(deftest dst.1
(is-dst-change-usa-spring-utime
(encode-universal-time 0 0 0 2 4 2000)) t)
-
(deftest dst.2
(is-dst-change-usa-spring-utime
(encode-universal-time 0 0 0 1 4 2000)) nil)
-
(deftest dst.3
(is-dst-change-usa-spring-utime
(encode-universal-time 0 0 0 3 4 2000)) nil)
-
(deftest dst.4
(is-dst-change-usa-fall-utime
(encode-universal-time 0 0 0 31 10 2004)) t)
-
(deftest dst.5
(is-dst-change-usa-fall-utime
(encode-universal-time 0 0 0 30 10 2004)) nil)
-
(deftest dst.6
(is-dst-change-usa-fall-utime
(encode-universal-time 0 0 0 1 11 2000)) nil)
+)
+
+
+(deftest ekdc.1
+ (ensure-keyword-default-case (read-from-string "TYPE")) :type)
+
+(deftest ekdc.2
+ (ensure-keyword-default-case (read-from-string "type")) :type)
+
-;;; MOP Testing
+ ;;; MOP Testing
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (find-package '#:kmr-mop)