Use keyword/value command-line arguments for depcheck

This is to make it easier to add more options without dealing with
positional argument issues.

Author: xach

depcheck.lisp

@@ -111,8 +111,7 @@
                              (asdf:component-name system))))
                (when (and (stringp value) (zerop (length value)))))))
       (check-attribute 'asdf:system-description :description)
-      ;; Not yet
-      ;;(check-attribute 'asdf:system-license :license)
+      (check-attribute 'asdf:system-license :license)
       (check-attribute 'asdf:system-author :author))))
 
 (defun compute-dependencies (system-file system-name)
@@ -190,27 +189,54 @@
   (sb-alien:alien-funcall
    (sb-alien:extern-alien "disable_lossage_handler" (function sb-alien:void)))
   (setf *print-pretty* nil)
-  (when (equalp (second argv) "--asdf-version")
-    (format t "~A~%" (asdf:asdf-version))
-    (sb-ext:exit :code 0))
-  (when (equalp (second argv) "--sbcl-version")
-    (format t "~A~%" (lisp-implementation-version))
-    (sb-ext:exit :code 0))
-  (unless (getenv "DEPCHECK_DEBUG")
-    (sb-ext:disable-debugger))
-  (setenv "SBCL_HOME"
-          (load-time-value
-           (directory-namestring sb-int::*core-string*)))
-  #+nil
-  (setenv "CC" "gcc")
-  (eval *load-op-wrapper*)
-  (when (getenv "DEPCHECK_FRESH_FASLS")
-    (set-fasl-output-directory (pathname (format nil "/tmp/depcheck/~D/"
-						 (getpid)))))
-  (destructuring-bind (index project system dependency-file errors-file
-                             &optional *metadata-required-p*)
-      (rest argv)
+  (sb-ext:disable-debugger)
+  (let (index project system dependency-file errors-file
+        (args (rest argv)))
+    (macrolet ((check-args (&rest vars)
+                 `(progn
+                    ,@(loop for var in vars
+                            for flag = (format nil "--~A"
+                                               (string-downcase var))
+                            collect
+                            `(unless ,var
+                               (error "Missing option ~S" ,flag))))))
+      (loop
+        (when (endp args)
+          (check-args index project system dependency-file errors-file)
+          (return))
+        (let ((arg (pop args)))
+          (cond ((equal arg "--index")
+                 (setf index (pop args)))
+                ((equal arg "--project")
+                 (setf project (pop args)))
+                ((equal arg "--system")
+                 (setf system (pop args)))
+                ((equal arg "--dependency-file")
+                 (setf dependency-file (pop args)))
+                ((equal arg "--errors-file")
+                 (setf errors-file (pop args)))
+                ;; Optional args follow
+                ((equal arg "--asdf-version")
+                 (write-line (asdf:asdf-version))
+                 (sb-ext:exit :code 0))
+                ((equal arg "--sbcl-version")
+                 (write-line (lisp-implementation-version))
+                 (sb-ext:exit :code 0))
+                ((equal arg "--debug")
+                 (sb-ext:enable-debugger))
+                ((equal arg "--metadata-required")
+                 (setf *metadata-required-p* t))
+                ((equal arg "--fasl-directory")
+                 (let ((path (pop args)))
+                   (ensure-directories-exist path)
+                   (set-fasl-output-directory (truename path))))
+                (t
+                 (error "Unknown argument ~S" arg))))))
     (setf *systems* (load-asdf-system-table index))
+    (setenv "SBCL_HOME"
+            (load-time-value
+             (directory-namestring sb-int::*core-string*)))
+    (eval *load-op-wrapper*)
     (with-open-file (*error-output* errors-file
                                     :if-exists :supersede
                                     :direction :output)

dist-cache.lisp

@@ -252,17 +252,26 @@ if needed."
   "If true, a depcheck will fail if :author/:description/:license
   options are missing from a system.")
 
-(defun depcheck (primary-system sub-system)
+(defun depcheck (primary-system sub-system &key fasl-directory)
   (ensure-system-file-index)
   (ensure-in-anonymous-directory
-    (let ((win (temporary-pathname "depcheck-win.txt"))
-          (fail (temporary-pathname "depcheck-fail.txt")))
+    (let* ((win (temporary-pathname "depcheck-win.txt"))
+           (fail (temporary-pathname "depcheck-fail.txt"))
+           (args (mapcan #'identity
+                         (list
+                          (list :index (native (translate-logical-pathname *system-file-index-file*)))
+                          (list :project primary-system)
+                          (list :system sub-system)
+                          (list :dependency-file win)
+                          (list :errors-file fail)
+                          (when *system-metadata-required-p*
+                            (list :metadata-required))
+                          (when fasl-directory
+                            (list :fasl-directory fasl-directory))))))
       (ignore-errors (delete-file win))
       (ignore-errors (delete-file fail))
       (ignore-errors
-        (run "depcheck"
-             (native (translate-logical-pathname *system-file-index-file*))
-             primary-system sub-system win fail *system-metadata-required-p*))
+       (apply #'run "depcheck" args))
       (let* ((won (probe-file win))
              (first-line (and won (ignore-errors (first-line-of win))))
              (result (and first-line (split-spaces first-line))))