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.

module/ice-9/boot-9.scm

@@ -4656,8 +4656,11 @@ R7RS."
 ;;;
 
 (call-with-values (lambda ()
+                    ;; Capture syntax? binding, later removed from root
+                    ;; module.
+                    (let ((syntax? syntax?))
                       (include-from-path "ice-9/read.scm")
-                    (values read read-syntax))
+                      (values read read-syntax)))
   (lambda (read* read-syntax*)
     (set! read read*)
     (set! read-syntax read-syntax*)))

module/ice-9/read.scm

@@ -877,7 +877,17 @@
 (define* (read-syntax #:optional (port (current-input-port)))
   (define filename (port-filename port))
   (define (annotate line column datum)
+    ;; Usually when reading compound expressions consisting of multiple
+    ;; syntax objects, like lists, the "leaves" of the expression are
+    ;; 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))))
+                       #:source (vector filename line (1- column)))))
   (%read port annotate syntax->datum))

test-suite/tests/reader.test

@@ -20,8 +20,9 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (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
@@ -546,6 +547,10 @@
  (with-test-prefix "deprecated #{}# escapes"
    (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:
 ;;; eval: (put 'with-read-options 'scheme-indent-function 1)
 ;;; End: