mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Fix bug for read-syntax on ( . args)
* module/ice-9/boot-9.scm: Capture syntax?. * module/ice-9/read.scm (read-syntax): Avoid re-annotating objects. * test-suite/tests/reader.test ("read-syntax"): Add test.
This commit is contained in:
parent
3bce507407
commit
3383a2cb10
3 changed files with 25 additions and 7 deletions
|
@ -4656,8 +4656,11 @@ R7RS."
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(call-with-values (lambda ()
|
(call-with-values (lambda ()
|
||||||
(include-from-path "ice-9/read.scm")
|
;; Capture syntax? binding, later removed from root
|
||||||
(values read read-syntax))
|
;; module.
|
||||||
|
(let ((syntax? syntax?))
|
||||||
|
(include-from-path "ice-9/read.scm")
|
||||||
|
(values read read-syntax)))
|
||||||
(lambda (read* read-syntax*)
|
(lambda (read* read-syntax*)
|
||||||
(set! read read*)
|
(set! read read*)
|
||||||
(set! read-syntax read-syntax*)))
|
(set! read-syntax read-syntax*)))
|
||||||
|
|
|
@ -877,7 +877,17 @@
|
||||||
(define* (read-syntax #:optional (port (current-input-port)))
|
(define* (read-syntax #:optional (port (current-input-port)))
|
||||||
(define filename (port-filename port))
|
(define filename (port-filename port))
|
||||||
(define (annotate line column datum)
|
(define (annotate line column datum)
|
||||||
(datum->syntax #f ; No lexical context.
|
;; Usually when reading compound expressions consisting of multiple
|
||||||
datum
|
;; syntax objects, like lists, the "leaves" of the expression are
|
||||||
#:source (vector filename line (1- column))))
|
;; annotated but the "root" isn't. Like in (A . B), A and B will be
|
||||||
|
;; annotated but the pair won't. Therefore the usually correct
|
||||||
|
;; thing to do is to just annotate the result. However in the case
|
||||||
|
;; of reading ( . C), the result is the already annotated C, which
|
||||||
|
;; we don't want to re-annotate. Therefore we avoid re-annotating
|
||||||
|
;; already annotated objects.
|
||||||
|
(if (syntax? datum)
|
||||||
|
datum
|
||||||
|
(datum->syntax #f ; No lexical context.
|
||||||
|
datum
|
||||||
|
#:source (vector filename line (1- column)))))
|
||||||
(%read port annotate syntax->datum))
|
(%read port annotate syntax->datum))
|
||||||
|
|
|
@ -20,8 +20,9 @@
|
||||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
(define-module (test-suite reader)
|
(define-module (test-suite reader)
|
||||||
:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
:use-module (test-suite lib))
|
#:use-module (test-suite lib)
|
||||||
|
#:use-module (system syntax internal))
|
||||||
|
|
||||||
|
|
||||||
(define exception:eof
|
(define exception:eof
|
||||||
|
@ -546,6 +547,10 @@
|
||||||
(with-test-prefix "deprecated #{}# escapes"
|
(with-test-prefix "deprecated #{}# escapes"
|
||||||
(pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))))
|
(pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))))
|
||||||
|
|
||||||
|
(with-test-prefix "read-syntax"
|
||||||
|
(pass-if-equal "annotations" 'args
|
||||||
|
(syntax-expression (call-with-input-string "( . args)" read-syntax))))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'with-read-options 'scheme-indent-function 1)
|
;;; eval: (put 'with-read-options 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue