[bug#59592] Keep asd-systems for cl-* packages

[Guillaume Le Vaillant <glv@posteo.net>]

[-- Attachment #1.1: Type: text/plain, Size: 1540 bytes --]

Hi,

The 'asd-systems' field contains the minimal subset of the ASDF systems
defined by a library that, when compiled, compiles all the systems of
the library.

For example, the ironclad package has many subsystems:
  "ironclad/ciphers"
  "ironclad/digests"
  "ironclad/cipher/aes"
  "ironclad/cipher/threefish"
  "ironclad/digest/sha256"
  "ironclad/public-key/ed25519"
  ...
but the 'asd-systems' field only contains "ironclad".

The mcclim package also has many subsystems:
  "automaton"
  "clim"
  "clim-core"
  "clim-core/frames"
  "clim-core/system"
  "drei-mcclim"
  "esa-mcclim"
  "mcclim-backend-common"
  "mcclim-fonts"
  "slim"
  ...
but the 'asd-systems' field only contains the top level ones, "mcclim",
"clim-examples" and "clim-debugger".

So you can't rely on the contents of 'asd-systems' to have a complete
list of the systems defined by a library.

You could get the full list by searching the for 'defsystem' forms in
the sources directly, with something like:

--8<---------------cut here---------------start------------->8---
find sources -name "*.asd" -exec grep "(defsystem" {} \; | cut -d ' ' -f 2
--8<---------------cut here---------------end--------------->8---

But it would only work for systems not using the package-inferred-system
feature of ASDF.


In my files, I found a function (I don't remember where I got it from)
that can get all the dependencies of a loaded system, even the ones
using package-inferred-system. Maybe it could be modified to limit the
results to a specific library's source tree...


[-- Attachment #1.2: get-dependencies.lisp --]
[-- Type: application/octet-stream, Size: 2904 bytes --]

(asdf!load-system :fset)

(defun get-dependencies (system)
  "Returns a set with all dependencies of a given system.
   System should be loaded first."
  (labels ((normalize (name)
             (etypecase name
               (string (string-downcase name))
               (symbol (normalize (symbol-name name)))
               (list
                (let ((dep-type (first name))
                      (supported-dep-types (list :version :feature :require)))
                  (unless (member dep-type
                                  supported-dep-types)
                    (error "This component \"~A\" should have first element from this list: ~A."
                           name
                           supported-dep-types))
                  
                  (normalize
                   (case dep-type
                     (:version (second name))
                     (:feature (third name))
                     (:require (second name)))))))))
    
    (let ((processed (fset:set))
          (queue (fset:set (normalize system))))
      
      (do ((current-name (fset:arb queue)
                         (fset:arb queue)))
          ((null current-name)
           ;; return result
           processed)

        ;; Remove current name from the queue
        (setf queue
              (fset:less queue current-name))
        ;; And put it into the "processed" pool
        (setf processed
              (fset:with processed current-name))
        
        ;; And add it's dependencies which aren't processed or in the queue already
        ;; Sometimes system can't be found because itself depends on some feature,
        ;; for example, you can specify dependency as a list:
        ;; (:FEATURE :SBCL (:REQUIRE :SB-INTROSPECT))
        ;; and it will be loaded only on SBCL.
        ;; When we are collecting dependencies on another implementation,
        ;; we don't want to fail with an error because ASDF is unable to find
        ;; such dependencies
        (let* ((system (ignore-errors
                        (asdf:find-system current-name)))
               (deps (when system
                       (asdf:component-sideway-dependencies system))))
          (dolist (dep deps)
            (let ((normalized-dep (normalize dep)))
              (unless (or (fset:lookup processed normalized-dep)
                          (fset:lookup queue normalized-dep))
                (setf queue
                      (fset:with queue normalized-dep)))))))

      (values processed))))

#|
DEPENDENCIES> (asdf:load-system :clinch)
DEPENDENCIES> (get-dependencies :clinch)
#{
  "cffi"
  "sdl2"
  "uiop"
  "babel"
  "swank"
  "clinch"
  "cl-glut"
  "cl-json"
  "cl-ppcre"
  "rtg-math"
  "cl-opengl"
  "cl-plus-c"
  "alexandria"
  "cl-autowrap"
  "glsl-symbols"
  "defpackage-plus"
  "trivial-garbage"
  "trivial-timeout"
  "bordeaux-threads"
  "trivial-channels"
  "trivial-features" }
|#

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]