syntax/loc: only use loc arg if it has source or position

pkgs/racket-doc/scribblings/reference/stx-patterns.scrbl

@@ -486,16 +486,28 @@ Illegal as an expression form. The @racket[unsyntax-splicing] form is
 for use only with a @racket[quasisyntax] template.}
 
 
-@defform[(syntax/loc stx-expr template)]{
+@defform[(syntax/loc stx-expr template)
+         #:contracts ([stx-expr syntax?])]{
 
 Like @racket[syntax], except that the immediate resulting syntax
 object takes its source-location information from the result of
-@racket[stx-expr] (which must produce a syntax object), unless the
-@racket[template] is just a pattern variable, or both the source and
-position of @racket[stx-expr] are @racket[#f].}
+@racket[stx-expr] (which must produce a syntax object).
 
+Only the source location of the immediate result---the ``outermost''
+syntax object---is adjusted. The source location is @emph{not}
+adjusted if both the source and position of @racket[stx-expr] are
+@racket[#f]. The source location is adjusted only if the resulting
+syntax object comes from the template itself rather than the value of
+a syntax pattern variable. For example, if @racket[_x] is a syntax
+pattern variable, then @racket[(syntax/loc stx-expr _x)] does not use
+the location of @racket[stx-expr].
 
-@defform[(quasisyntax/loc stx-expr template)]{
+@history[#:changed "6.90.0.25" @elem{Previously, @racket[syntax/loc]
+did not enforce the contract on @racket[stx-expr] if @racket[template]
+was just a pattern variable.}]}
+
+@defform[(quasisyntax/loc stx-expr template)
+         #:contracts ([stx-expr syntax?])]{
 
 Like @racket[quasisyntax], but with source-location assignment like
 @racket[syntax/loc].}

pkgs/racket-test-core/tests/racket/stx.rktl

@@ -2646,6 +2646,26 @@
       (with-syntax ([(x ...) #'(4 5 6)])
         (syntax->datum #'((~? x) ...))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for syntax/loc
+
+(let ()
+  (define (f stx) (list (syntax-source stx) (syntax-position stx)))
+  (define (same-src? x y) (equal? (syntax-source x) (syntax-source y)))
+  (define good1 (datum->syntax #f 'good '(source #f #f 1 4)))
+  (define good3 (datum->syntax #f 'good '(source #f #f #f #f)))
+  (define good4 (datum->syntax #f 'good '(#f #f #f 1 4)))
+  (define bad1  (datum->syntax #f 'bad #f))
+  (test '(source 1)  'syntax/loc (f (syntax/loc good1 (x))))
+  (test '(source #f) 'syntax/loc (f (syntax/loc good3 (x))))
+  (test '(#f 1)      'syntax/loc (f (syntax/loc good4 (x))))
+  (test #t 'syntax/loc (same-src? (syntax/loc bad1 (x)) (syntax (x))))
+  ;; syntax/loc only applies loc to *new* syntax
+  (with-syntax ([x #'here])
+    (test #t 'syntax/loc (same-src? (syntax/loc good1 x) (syntax x))))
+  (with-syntax ([(x ...) #'()] [y #'(here)])
+    (test #t 'syntax/loc (same-src? (syntax/loc good1 (x ... . y)) (syntax y)))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/collects/racket/private/template.rkt

@@ -596,9 +596,15 @@
       (do-template stx (cadr s) #f #f)
       (raise-syntax-error #f "bad syntax" stx)))
 
+;; check-loc : Symbol Any -> (U Syntax #f)
+;; Raise exn if not syntax. Returns same syntax if suitable for srcloc
+;; (ie, if at least syntax-source or syntax-position set), #f otherwise.
 (define (check-loc who x)
-  (if (syntax? x) x (raise-argument-error who "syntax?" x)))
-
+  (if (syntax? x)
+      (if (or (syntax-source x) (syntax-position x))
+          x
+          #f)
+      (raise-argument-error who "syntax?" x)))
 
 ;; ============================================================
 ;; Run-time support
@@ -653,7 +659,7 @@
 
 (define (t-append xs ys) (if (null? ys) xs (append xs ys)))
 (define (t-resyntax loc stx g) (datum->syntax stx g (or loc stx) stx))
-(define (t-relocate g loc) (datum->syntax g (syntax-e g) loc g))
+(define (t-relocate g loc) (datum->syntax g (syntax-e g) (or loc g) g))
 (define (t-orelse* g1 g2)
   ((let/ec escape
      (with-continuation-mark