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

Sorry!  Pushed now.

Christophe

Stas Boukarev <[email protected]> writes:

> 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