diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index fa9e35a..8c3ac44 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -19,7 +19,7 @@ "fail-fast": false, "matrix": { "lisp": [ - "sbcl-bin", + "sbcl-bin/2.5.10", "ccl-bin" ] } diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 58439d9..f67f303 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -19,7 +19,7 @@ "env": { "OS": "ubuntu-latest", "QUICKLISP_DIST": "quicklisp", - "LISP": "sbcl-bin" + "LISP": "sbcl-bin/2.5.10" }, "steps": [ { diff --git a/.github/workflows/linter.yml b/.github/workflows/linter.yml index 2d2a352..1694bf9 100644 --- a/.github/workflows/linter.yml +++ b/.github/workflows/linter.yml @@ -19,7 +19,7 @@ "env": { "OS": "ubuntu-latest", "QUICKLISP_DIST": "quicklisp", - "LISP": "sbcl-bin" + "LISP": "sbcl-bin/2.5.10" }, "steps": [ { diff --git a/docs/changelog.lisp b/docs/changelog.lisp index 848bfd5..e88ef50 100644 --- a/docs/changelog.lisp +++ b/docs/changelog.lisp @@ -12,6 +12,8 @@ "1Gb" "DYNAMIC_SPACE_SIZE" "HTTP")) + (0.7.0 2025-12-24 + "* A new feature was added to the imports linter. Now it will warn you if you forgot to include some files into the ASDF system definition. For now it works only for package-inferred ASDF systems.") (0.6.0 2025-05-11 "* Now imports linter will ignore packages which are not correspond to ASDF system.") (0.5.0 2025-05-02 diff --git a/qlfile.lock b/qlfile.lock index d54c116..abd43e7 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -1,11 +1,11 @@ ("quicklisp" . (:class qlot/source/dist:source-dist - :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) - :version "2023-10-21")) + :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) + :version "2025-06-22")) ("ultralisp" . (:class qlot/source/dist:source-dist - :initargs (:distribution "http://dist.ultralisp.org/" :%version :latest) - :version "20240709174002")) + :initargs (:distribution "https://dist.ultralisp.org/" :%version :latest) + :version "20251223054000")) ("slynk" . (:class qlot/source/github:source-github :initargs (:repos "svetlyak40wt/sly" :ref nil :branch "patches" :tag nil) diff --git a/src/ci.lisp b/src/ci.lisp index fdcdaf4..403466a 100644 --- a/src/ci.lisp +++ b/src/ci.lisp @@ -16,6 +16,10 @@ :on-pull-request t :cache t :jobs ((40ants-ci/jobs/linter:linter + ;; Until the issue with + ;; Bug in readtable iterators or concurrent access? + ;; will be resolved in the named-readtables. + :lisp "sbcl-bin/2.5.10" :asdf-systems ("40ants-linter" "40ants-linter-docs" "40ants-linter-tests")))) @@ -25,7 +29,12 @@ :by-cron "0 10 * * 1" :on-pull-request t :cache t - :jobs ((build-docs :asdf-system "40ants-linter-docs"))) + :jobs ((build-docs + ;; Until the issue with + ;; Bug in readtable iterators or concurrent access? + ;; will be resolved in the named-readtables. + :lisp "sbcl-bin/2.5.10" + :asdf-system "40ants-linter-docs"))) (defworkflow ci @@ -34,6 +43,9 @@ :on-pull-request t :cache t :jobs ((run-tests - :lisp ("sbcl-bin" + ;; Until the issue with + ;; Bug in readtable iterators or concurrent access? + ;; will be resolved in the named-readtables. + :lisp ("sbcl-bin/2.5.10" "ccl-bin") :coverage t))) diff --git a/src/imports.lisp b/src/imports.lisp index b33f5d7..3843194 100644 --- a/src/imports.lisp +++ b/src/imports.lisp @@ -4,11 +4,23 @@ (:import-from #:alexandria #:curry #:with-input-from-file) + (:import-from #:serapeum + #:soft-list-of + #:->) (:export #:analyze-imports)) (in-package 40ants-linter/imports) +(-> sort-pathnames ((soft-list-of pathname)) + (values (soft-list-of pathname) &optional)) + +(defun sort-pathnames (pathnames) + (sort (copy-list pathnames) + #'string< + :key #'namestring)) + + (defun system-files (system-name &optional (visited (make-hash-table :test 'equal))) (let* ((system (asdf:find-system system-name)) (primary-name (asdf:primary-system-name system))) @@ -33,9 +45,7 @@ (system-files dep visited)) :test #'equal))) - (values (sort files - #'string< - :key #'namestring))))) + (sort-pathnames files)))) (defun package-definition-p (form) @@ -307,6 +317,66 @@ (package-name package))) +(-> get-package-name-from (list) + (values (or null string))) + +(defun get-package-name-from (form) + "Returns a downcased package name if the form is DEFPACKAGE or UIOP:DEFINE-PACKAGE macro." + (when (and (consp form) + (symbolp (car form)) + (member (car form) + '(defpackage uiop:define-package))) + (string-downcase (second form)))) + + +(-> get-file-package (pathname) + (values (or null string) &optional)) + +(defun get-file-package (filename) + (loop for form in (uiop:with-safe-io-syntax () + (handler-case (uiop:read-file-forms filename) + ;; Sometimes there might be other lisp files, + ;; which belong to other system. For example, + ;; Systems like 40ants-linter and 40ants-linter-ci + ;; can share the same folder ./src/ + ;; And whe + (serious-condition () + (return-from get-file-package nil)))) + for package-name = (get-package-name-from form) + thereis package-name)) + + +(defun all-system-files (system) + (unless (typep system 'asdf:package-inferred-system) + (error "We can search for system files only for ASDF package inferred system, because they match to the file-system structure.")) + (let* ((root-dir (asdf:component-pathname system)) + (pathname-pattern (merge-pathnames (merge-pathnames + (make-pathname :name uiop:*wild* + :type "lisp") + uiop:*wild-inferiors*) + root-dir)) + (all-files (directory pathname-pattern)) + (system-name (asdf:component-name system)) + (prefix-to-search (str:ensure-suffix "/" system-name))) + (sort-pathnames + (remove-if-not (lambda (filename) + (let ((file-package (get-file-package filename))) + (when file-package + (str:starts-with-p prefix-to-search + file-package)))) + all-files)))) + + +(-> make-relative-pathname (asdf:system pathname) + (values pathname &optional)) + +(defun make-relative-pathname (asdf-system pathname) + "Returns a pathname relative to the directory where asdf-system definition is stored." + (let ((base-dir (asdf:system-source-directory asdf-system))) + (uiop:enough-pathname pathname + base-dir))) + + (defun analyze-imports (system-name &key (allow-unused-imports nil)) "Prints report about issues of IMPORT-FROM clauses in a given package-inferred ASDF system. @@ -331,15 +401,19 @@ (asdf:system (asdf:component-name package-or-system))))) (if symbols - (format nil "~A (~{~S~^, ~})" - name - symbols) - (format nil "~A (for proper loading from Quicklisp)" - name))))) + (format nil "~A (~{~S~^, ~})" + name + symbols) + (format nil "~A (for proper loading from Quicklisp)" + name))))) (loop with system = (asdf:registered-system system-name) with system-dependencies = (asdf:system-depends-on system) with num-problems = 0 - for filename in (system-files system-name) + with all-system-files = (all-system-files system) + with used-files = (system-files system-name) + for orphaned-files = (set-difference all-system-files used-files + :test #'uiop:pathname-equal) + for filename in used-files for (missing-imports unused-imports not-imported-symbols @@ -350,12 +424,13 @@ not-found-packages (and unused-imports (not allow-unused-imports))) - do (format t "~2&~A:~%" - filename) - (incf num-problems - (+ (length missing-imports) - (length not-found-packages) - (if allow-unused-imports + do (format t "~2&~A:~%" + filename) + (incf num-problems + (+ (length missing-imports) + (length not-found-packages) + (length orphaned-files) + (if allow-unused-imports 0 (length unused-imports)))) when missing-imports @@ -373,4 +448,15 @@ (mapcar #'downcased-package-name unused-imports)) (incf num-problems (length unused-imports)) - finally (return num-problems)))) + finally (return + (progn + (when orphaned-files + (format t "These files are not used in the ASDF system.~%They either contain some old unwanted code or should be included in the ~A file:~%~{ - ~A~^~%~}~2%" + (make-relative-pathname system + (asdf:system-source-file system)) + (mapcar (curry #'make-relative-pathname system) + (sort-pathnames orphaned-files)))) + + (incf num-problems (length unused-imports)) + + num-problems)))))