master: Silence "<internal-feature> no longer present on *FEATURES*"

melisgl via Sbcl-commits <[email protected]> Mon, 29 Jun 2026 12:19:21 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  3dc327b828e6b4c49fff112df6bb99b66fec4d45 (commit)
      from  6ac843434ae870fd85547d5de7afd0d6e49f877d (commit)

- Log -----------------------------------------------------------------
commit 3dc327b828e6b4c49fff112df6bb99b66fec4d45
Author: Gabor Melis <[email protected]>
Date:   Sun Jun 7 23:37:22 2026 +0200

    Silence "<internal-feature> no longer present on *FEATURES*"
    
    ... warnings when *READ-SUPPRESS*.
---
 contrib/sb-introspect/introspect.lisp |  1 +
 src/code/sharpm.lisp                  |  3 +-
 tests/reader.pure.lisp                | 59 +++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index bbfe71463..4eda5e3ca 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -754,6 +754,7 @@ or a method combination name."
         callees)))
 
 (defun find-function-callers (function &optional (spaces '(:all)))
+  ;; FIXME: :IMMOBILE-SPACE is an internal feature
   "List functions that call FUNCTION by searching SPACES for code objects.
 This can make previously garbage objects live.
 
diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index f81c66a14..03879b7dd 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -493,7 +493,8 @@
        (cond (present
               t)
              ((memq x +internal-features+)
-              (warn "~s is no longer present in ~s" x '*features*)))))
+              (unless *read-suppress*
+                (warn "~s is no longer present in ~s" x '*features*))))))
     (t
      (error "invalid feature expression: ~S" x))))
 
diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 1c3b000d2..e354898de 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -647,3 +647,62 @@
                    (lambda (c)
                      (invoke-restart (find-restart 'symbol c) 'pi))))
     (assert (eq (read-from-string "missing-package::symbol") 'pi))))
+
+(with-test (:name (:read-suppress :present-feature))
+  (assert (equal (multiple-value-list (read-from-string "#-sbcl 1 2"))
+                 '(2 10)))
+  (assert (equal (multiple-value-list (read-from-string "#+sbcl 1 2"))
+                 '(1 9)))
+  (let ((*read-suppress* t))
+    (assert (equal (multiple-value-list
+                    (let ((*read-suppress* t))
+                      (read-from-string "#-sbcl 1 2")))
+                   '(nil 10))))
+  (assert (equal (multiple-value-list
+                  (let ((*read-suppress* t))
+                    (read-from-string "#+sbcl 1 2")))
+                 '(nil 9))))
+
+(with-test (:name (:read-suppress :missing-feature))
+  (assert (equal (multiple-value-list (read-from-string "#-abcd 1 2"))
+                 '(1 9)))
+  (assert (equal (multiple-value-list (read-from-string "#+abcd 1 2"))
+                 '(2 10)))
+  (let ((*read-suppress* t))
+    (assert (equal (multiple-value-list
+                    (let ((*read-suppress* t))
+                      (read-from-string "#-abcd 1 2")))
+                   '(nil 9))))
+  (assert (equal (multiple-value-list
+                  (let ((*read-suppress* t))
+                    (read-from-string "#+abcd 1 2")))
+                 '(nil 10))))
+
+(with-test (:name (:read-suppress :internal-feature))
+  ;; The test harness appends SB-IMPL::+INTERNAL-FEATURES+ to *FEATURES*.
+  (let* ((*features* (set-difference *features* sb-impl::+internal-features+))
+         (name (princ-to-string (first sb-impl::+internal-features+)))
+         (negative (format nil "#-~A 1 2" name))
+         (positive (format nil "#+~A 1 2" name))
+         (negative-read-pos (+ (length name) 5))
+         (positive-read-pos (+ (length name) 6)))
+    (assert-signal
+     (assert (equal (multiple-value-list (read-from-string negative))
+                    `(1 ,negative-read-pos)))
+     warning)
+    (assert-signal
+     (assert (equal (multiple-value-list (read-from-string positive))
+                    `(2 ,positive-read-pos)))
+     warning)
+    (assert-no-signal
+     (assert (equal (multiple-value-list
+                     (let ((*read-suppress* t))
+                       (read-from-string positive)))
+                    `(nil ,positive-read-pos)))
+     warning)
+    (assert-no-signal
+     (assert (equal (multiple-value-list
+                     (let ((*read-suppress* t))
+                       (read-from-string negative)))
+                    `(nil ,negative-read-pos)))
+     warning)))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL