Commit cb0b8233 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Corrected style warnings and a few sbcl dead code.

parent 1aa6da42
......@@ -48,6 +48,7 @@
#+clisp (:import-from "EXT" "GC")
#+cmu (:import-from "EXTENSIONS" "GC")
#+ccl (:import-from "CCL" "GC")
(:shadowing-import-from "COM.INFORMATIMAGO.CLEXT.CLOSER-WEAK" "GETHASH")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.CLEXT.CLOSER-WEAK.TEST")
......
......@@ -91,7 +91,7 @@ Journal
"algorithme" "en" "question" "a" "ete" "publie"
"en" "1960" "dans" "IBM" "Journal"))
(function string<))))
(test equal sorted-list stream-contents
(check equal sorted-list stream-contents
() "~%~20A=~S~%~20A=~S~%"
"sorted-list" sorted-list
"stream-contents" stream-contents)))
......@@ -120,16 +120,16 @@ Journal
(run-program "true" '() :wait nil :error "TESTERR.TXT")
(sleep 1)
(test equal '() (text-file-contents "TESTERR.TXT"))
(check equal '() (text-file-contents "TESTERR.TXT"))
(run-program "true" '() :wait t :error "TESTERR.TXT")
(test equal '() (text-file-contents "TESTERR.TXT"))
(check equal '() (text-file-contents "TESTERR.TXT"))
(let ((process (run-program "sh" '("-c" "echo error 1>&2")
:wait nil :input nil :output nil :error :stream)))
(test equal '("error")
(check equal '("error")
(unwind-protect
(text-stream-contents (process-error process))
(close (process-error process)))))
......@@ -138,7 +138,7 @@ Journal
(ignore-errors (delete-file "TESTERR.TXT"))
(run-program "sh" '("-c" "echo error 1>&2")
:wait t :input nil :output nil :error "TESTERR.TXT")
(test equal '("error") (text-file-contents "TESTERR.TXT"))
(check equal '("error") (text-file-contents "TESTERR.TXT"))
(with-open-file (err "TESTERR.TXT"
......@@ -147,7 +147,7 @@ Journal
)
(run-program "sh" '("-c" "echo error 1>&2")
:wait t :input nil :output nil :error err))
(test equal '("error") (text-file-contents "TESTERR.TXT"))
(check equal '("error") (text-file-contents "TESTERR.TXT"))
(run-program "printf" '("Hello\\nWorld\\n") :wait t)
......@@ -155,7 +155,7 @@ Journal
(run-program "printf" '("Hello\\nWorld\\n") :wait nil)
(let ((process (run-program "printf" '("Hello\\nWorld\\n") :wait nil :output :stream)))
(test equal '("Hello" "World")
(check equal '("Hello" "World")
(unwind-protect
(loop
:for line = (read-line (process-output process) nil nil)
......@@ -168,14 +168,14 @@ Journal
#+ccl :sharing #+ccl :lock)
(run-program "printf" '("Hello\\nWorld\\n") :wait nil :output out)
(sleep 1))
(test equal '("Hello" "World") (text-file-contents "TESTOUT.TXT"))
(check equal '("Hello" "World") (text-file-contents "TESTOUT.TXT"))
(with-open-file (out "TESTOUT.TXT"
:direction :output :if-does-not-exist :create :if-exists :supersede
#+ccl :sharing #+ccl :lock)
(run-program "printf" '("Hello\\nWorld\\n") :wait t :output out))
(test equal '("Hello" "World") (text-file-contents "TESTOUT.TXT"))
(check equal '("Hello" "World") (text-file-contents "TESTOUT.TXT"))
(run-program "sort" '() :environment '(("LC_CTYPE" . "C") ("LC_COLLATE" . "C"))
......
......@@ -205,6 +205,7 @@ RETURN: A string containing a human readable representation of the polynom POLY
))
"A vector with all legal odd-parity bytes, in 7-bit order.")
(declaim (inline even-parity odd-parity))
(defun even-parity (byte)
"
......@@ -220,7 +221,7 @@ RETURN: The BYTE with the parity bit set to odd parity.
"
(aref *odd-parity* (logand byte #x7f)))
(declaim (inline even-parity odd-parity))
(defun remove-bit7 (poly)
......
......@@ -586,18 +586,18 @@ NOTE: Only the keywords listed in *DURATION-KEYWORDS* are really allowed.
`(progn
(defgeneric ,name (duration)
(:documentation ,(let ((*print-circle* nil))
(format nil "RETURN: The ~A of the duration.
(format nil "RETURN: The ~A of the duration.
NOTE: This is not the duration expressed in ~:*~A, just the ~:*~A
component of the duration." (string-downcase name))))
(:method ((self duration))
(getf (slot-value self 'expression)
',(intern (string name) "KEYWORD") 0)))
,@(unless
no-writer-p
`((defmethod (setf ,name) (value (self duration))
(setf (getf (slot-value self 'expression)
',(intern (string name) "KEYWORD"))
value))))
,@(unless no-writer-p
`((defgeneric (setf ,name) (value duration))
(defmethod (setf ,name) (value (self duration))
(setf (getf (slot-value self 'expression)
',(intern (string name) "KEYWORD"))
value))))
',name)))
(define-accessor seconde)
(define-accessor minute)
......@@ -1001,6 +1001,7 @@ NOTE: UNIVERSAL-TIME when present gives a base date with
(with-slots (year month day hour minute seconde) (to-timezone self 0)
(list year month day hour minute seconde)))
(defgeneric units-of-list-of-numbers (date))
(defmethod units-of-list-of-numbers ((self gregorian-calendar-date))
(declare (ignorable self))
(list :year :month :day :hour :minute :seconde))
......
......@@ -263,7 +263,7 @@ switches to hash-tables, and below which it switches to A-lists."))
:accessor adaptating-dictionary-limit))
(:documentation "A dictionary that changes between an A-list implementation and a hash-table implementation depending on the number of entries."))
(defgeneric adaptating-dictionary-adapt (dictionary))
(defmethod adaptating-dictionary-adapt ((dictionary adaptating-dictionary))
(flet ((copy-dictionary (dictionary type)
(make-dictionary type
......
......@@ -180,6 +180,8 @@ License:
(defun index-set (&rest elements)
(copy 'index-set elements))
(defgeneric check-invariant (object))
(defmethod check-invariant ((set index-set))
(assert (slot-boundp set 'ranges))
(let ((ranges (slot-value set 'ranges)))
......
......@@ -153,10 +153,10 @@
(define-test test/iota ()
(test equalp (iota 5) '(0 1 2 3 4))
(test equalp (iota 5 0 -0.10) '(0 -0.1 -0.2 -0.3 -0.4))
(test equalp (iota (/ 30 4)) '(0 1 2 3 4 5 6))
(test equalp (iota (/ 30 4) 0 4) '(0 4 8 12 16 20 24)))
(check equalp (iota 5) '(0 1 2 3 4) ())
(check equalp (iota 5 0 -0.10) '(0 -0.1 -0.2 -0.3 -0.4))
(check equalp (iota (/ 30 4)) '(0 1 2 3 4 5 6))
(check equalp (iota (/ 30 4) 0 4) '(0 4 8 12 16 20 24)))
(define-test test/all ()
(test/list-lengths)
......
......@@ -638,7 +638,7 @@ RETURN: true if there was such an entry, or false otherwise.
;;;
(defparameter *dot-counter* 0)
(defgeneric generate-dot (graph))
(defmethod generate-dot ((self tree))
(let ((id (incf *dot-counter*)))
(with-open-file (dot (format nil "tree-~5,'0D.dot" id)
......@@ -706,6 +706,8 @@ RETURN: true if there was such an entry, or false otherwise.
(map 'string (function code-char)
#(#x1b #x5b #x30 #x6d)))
(defgeneric dump (object &optional indentation bar))
(defmethod dump ((self null) &optional (indentation "") (bar " "))
(declare (ignorable self))
(format t "~A~A~A+---- NIL~A~%" indentation bar *black* *normal*))
......
......@@ -272,6 +272,7 @@ inconsistent, a default newline = LF is used. This imports for \ escapes."))
(scanner-source self))
self)
(defgeneric text-term (scanner))
(defmethod text-term ((scanner scanner))
(format nil "~A~A" (field-separator scanner) +crlf+))
......
......@@ -815,7 +815,7 @@ RETURN: The generated HTML.
);;eval-when
(defmacro generate (&body body)
(defmacro generate ()
(append (generate-elements *elements*)
'('done)))
......
......@@ -1589,12 +1589,14 @@ IF-PACKAGE-EXISTS The default is :PACKAGE
;; (reduce 'union (cons (package-shadow-list p)
;; (mapcar 'rest (package-shadowing-import-list p)))))
(defgeneric package-shadow-list (package))
(defmethod package-shadow-list (package)
"Return the list of shadowed symbols (but not shadowing-imported ones)"
(remove package (package-shadowing-symbols package)
:test-not (function eql)
:key (function symbol-package)))
(defgeneric package-shadowing-import-list (package))
(defmethod package-shadowing-import-list (package)
"Return a list of lists of shadowing-imports.
Each sublist contains the package followed by its imported symbols."
......@@ -1607,7 +1609,7 @@ Each sublist contains the package followed by its imported symbols."
;; package that used them, or that imported them, then we won't
;; remember it, and will import them directly from their home.
;; This is probably not good.
(defgeneric package-import-from-list (package))
(defmethod package-import-from-list (package)
(let ((symbols '()))
(with-package-iterator (it package :present)
......@@ -1618,6 +1620,7 @@ Each sublist contains the package followed by its imported symbols."
(unless (eq home package) (push symbol symbols))
(return (classify-per-package symbols))))))))
(defgeneric package-symbols (package))
(defmethod package-symbols (package)
(let ((result '()))
(with-package-iterator (it package :present)
......@@ -1628,6 +1631,7 @@ Each sublist contains the package followed by its imported symbols."
(when (eq home package) (push symbol result))
(return result)))))))
(defgeneric package-export-list (package))
(defmethod package-export-list (package)
(let ((result '()))
(with-package-iterator (it package :external)
......
......@@ -315,6 +315,7 @@ RETURN: (scanner-current-token scanner).
"))
(defgeneric (setf scanner-source) (new-source scanner))
(defmethod (setf scanner-source) (new-source (scanner scanner))
(setf (slot-value scanner 'stream)
(etypecase (setf (slot-value scanner 'source) new-source)
......
......@@ -223,6 +223,8 @@ DO: Draws the frame FRAME of the SPRITE on the picture PICT,
(defgeneric background (picture)
(:documentation "The background character of the picture."))
(defgeneric data (picture))
(pjb-defclass picture nil
(:att data (array character 2) "Picture data.")
(:att background character (character " ") "The background character.")
......@@ -545,8 +547,6 @@ NOTE: A future implementation won't use DRAW-POINT for performance.
(defgeneric name (sprite)
(:documentation "Name of this sprite."))
(defgeneric data (sprite)
(:documentation "Sprite data."))
(defgeneric spot-x (sprite)
(:documentation "X coordinate of the spot of the sprite."))
(defgeneric spot-y (sprite)
......
......@@ -144,7 +144,8 @@ stdout in a string (going thru a file)."
options))
(declaim (inline trim))
(defun trim (string) (string-trim #(#\space #\tab #\newline) string))
(defun trim (string)
(and string (string-trim #(#\space #\tab #\newline) string)))
(defun uname (&rest options)
"Without OPTIONS, return a keyword naming the system (:LINUX, :DARWIN, etc).
......@@ -225,14 +226,17 @@ System and distrib are keywords, release is a string."
(:darwin
(when (probe-file "/System/Library/Frameworks/AppKit.framework/AppKit")
(setf distrib :apple))
(setf release (with-input-from-string (inp (shell-command-to-string "hostinfo"))
(loop
:for line = (read-line inp nil nil)
:while line
:when (search "Darwin Kernel Version" line)
:return (let ((release (fourth (words line))))
(subseq release 0 (position #\: release)))
:finally (return :unknown)))))
(let ((hostinfo (shell-command-to-string "hostinfo")))
(when hostinfo
(setf release (with-input-from-string (inp hostinfo)
(loop
:for line = (read-line inp nil nil)
:while line
:when (search "Darwin Kernel Version" line)
:return (let ((release (fourth (words line))))
(subseq release 0 (position #\: release)))
:finally (return :unknown))))
(setf release :unknown))))
(:unknown
(let ((host (trim (shell-command-to-string "hostinfo"))))
(cond
......
......@@ -37,7 +37,8 @@
(:nicknames "QL-DIST" "QL")
(:export "NAME" "PROJECT-NAME" "DIST" "PROVIDED-SYSTEMS"
"PROVIDED-RELEASES" "UPDATE-CLIENT" "UPDATE-ALL-DISTS"
"CLEAN" "WHERE-IS-SYSTEM" "QUICKLOAD" "REGISTER-LOCAL-PROJECTS"))
"CLEAN" "WHERE-IS-SYSTEM" "QUICKLOAD" "REGISTER-LOCAL-PROJECTS"
"INSTALLED-RELEASES"))
(defpackage "COM.INFORMATIMAGO.TOOLS.QUICKLISP"
(:use "COMMON-LISP"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment