suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix marshaling of #'(.... . ()) to bytecode

Browse Source
This commit is contained in:
Matthew Flatt 2014-07-10 14:11:46 +01:00
parent a479f18c28
commit 8f20264a83
2 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl
View File

@ -1819,6 +1819,25 @@
(define-syntax ++ (make-rename-transformer (datum->syntax #'here '+)))
(test #f values (displayln-syntax-local-value/immediate ++)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that syntax structure is preserved precisely with
;; #'(a . ()) as opposed to #'(a)
(let ()
(define-values (i o) (make-pipe))
(write (compile #'#'(a)) o)
(close-output-port o)
(define s (parameterize ([read-accept-compiled #t])
(read i)))
(test #t null? (cdr (syntax-e (eval s)))))
(let ()
(define-values (i o) (make-pipe))
(write (compile #'#'(a . ())) o)
(close-output-port o)
(define s (parameterize ([read-accept-compiled #t])
(read i)))
(test #t syntax? (cdr (syntax-e (eval s)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

2
racket/src/racket/src/syntax.c
View File

@ -6611,7 +6611,7 @@ static Scheme_Object *extract_for_common_wrap(Scheme_Object *a, int get_mark, in
else
return SCHEME_CDR(v);
}
} else if (!SCHEME_BOXP(v) && !SCHEME_VECTORP(v) && !SCHEME_HASHTRP(v) && !prefab_p(v)) {
} else if (!SCHEME_NULLP(v) && !SCHEME_BOXP(v) && !SCHEME_VECTORP(v) && !SCHEME_HASHTRP(v) && !prefab_p(v)) {
/* It's atomic. */
if (get_mark)
return SCHEME_CDR(a);