Re: master: Allow SB-COVER to read consing dot followed by read-eval

test-data-read-eval-cdr.lisp is not included.

On Fri, Nov 21, 2025 at 5:05 PM crhodes via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  5927a18f90cc95eb2846948f97a50739c851fdbf (commit)
>       from  cdc91d486634eb0f705f601bce061011c639727a (commit)
>
> - Log -----------------------------------------------------------------
> commit 5927a18f90cc95eb2846948f97a50739c851fdbf
> Author: Christophe Rhodes <[email protected]>
> Date:   Fri Nov 21 14:02:49 2025 +0000
>
>     Allow SB-COVER to read consing dot followed by read-eval
>
>     Some code, including in SBCL itself, is formed using constructs
>     like (FOO . #.(BAR)).  Make sure that SOURCE-PATH-SOURCE-POSITION can
>     handle the resulting construct from the specialized SB-COVER reader.
> ---
>  contrib/sb-cover/cover.lisp           |  8 +++++++-
>  contrib/sb-cover/file-info-tests.lisp | 28 +++++++++++++++++++++++++---
>  2 files changed, 32 insertions(+), 4 deletions(-)
>
> diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
> index 5ae6a3d74..b948e68dd 100644
> --- a/contrib/sb-cover/cover.lisp
> +++ b/contrib/sb-cover/cover.lisp
> @@ -892,6 +892,12 @@ Return the form and the source-map."
>            (error 'end-of-file :stream stream)
>            (values form source-map)))))
>
> +(defun nth-or-marker (n list)
> +  (cond
> +    ((read-eval-marker-p list) list)
> +    ((= n 0) (car list))
> +    (t (nth-or-marker (1- n) (cdr list)))))
> +
>  (defun source-path-source-position (path form source-map)
>    "Return the start position of PATH from FORM and SOURCE-MAP.  All
>  subforms along the path are considered and the start and end position
> @@ -899,7 +905,7 @@ of the deepest (i.e. smallest) possible form is returned."
>    ;; compute all subforms along path
>    (let ((forms (loop for ns on path
>                       for n = (car ns)
> -                     for f = form then (nth n f)
> +                     for f = form then (nth-or-marker n f)
>                       collect f into forms
>                       if (read-eval-marker-p f)
>                         do (return-from source-path-source-position (values nil nil))
> diff --git a/contrib/sb-cover/file-info-tests.lisp b/contrib/sb-cover/file-info-tests.lisp
> index 45c26907d..c9a2e79ef 100644
> --- a/contrib/sb-cover/file-info-tests.lisp
> +++ b/contrib/sb-cover/file-info-tests.lisp
> @@ -208,21 +208,43 @@
>                    0
>                    ;;( d e f u n   r e a d - e v a l   ( z   w )
>                    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> -                  ;;    # . ( g e n e r a t e   c o d e   ' z   ' w ) )
> +                  ;;    # . ( g e n e r a t e - c o d e   ' z   ' w ) )
>                    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
>
>  (read-eval 2 3)
>  ;; ... but probably the main thing is that this shouldn't show any
> -;; conditional-related states (or indeed read-suppressed states).
> +;; read-suppressed states, or ideally any conditional states either.
>  (assert (equalp (get-states "test-data-read-eval")
>                  ;;( i n - p a c k a g e   s b - c o v e r - t e s t )
>                  #(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
>                    0
>                    ;;( d e f u n   r e a d - e v a l   ( z   w )
>                    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> -                  ;;    # . ( g e n e r a t e   c o d e   ' z   ' w ) )
> +                  ;;    # . ( g e n e r a t e - c o d e   ' z   ' w ) )
>                    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
>
> +(sb-cover:clear-coverage)
> +(compile-load "test-data-read-eval-cdr")
> +;; see related comments about "test-data-read-eval"
> +(assert (equalp (get-states "test-data-read-eval-cdr")
> +                ;;( i n - p a c k a g e   s b - c o v e r - t e s t )
> +                #(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> +                  0
> +                  ;;( d e f u n   r e a d - e v a l - c d r   ( z   w )
> +                  0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> +                  ;;    ( p r o g n   .   # . ( l i s t   ( g e n e r a t e - c o d e   ' z   ' w ) ) ) )
> +                  0 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1)))
> +
> +(read-eval-cdr 2 3)
> +(assert (equalp (get-states "test-data-read-eval-cdr")
> +                ;;( i n - p a c k a g e   s b - c o v e r - t e s t )
> +                #(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> +                  0
> +                  ;;( d e f u n   r e a d - e v a l - c d r   ( z   w )
> +                  0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> +                  ;;    ( p r o g n   .   # . ( l i s t   ( g e n e r a t e - c o d e   ' z   ' w ) ) ) )
> +                  0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
> +
>  (sb-cover:clear-coverage)
>  (defvar *flag* t)
>  (compile-load "test-data-sharp-plus-sharp-dot")
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits