units: Fix an improper use of syntax instead of quote-syntax
This commit is contained in:
parent
5fb75e9f82
commit
86bb85931d
|
@ -2241,3 +2241,38 @@
|
|||
(test-runtime-error exn:fail:contract?
|
||||
"make-foo: broke its own contract"
|
||||
(dynamic-require ''use #f)))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Ellipses in signature bodies should not cause problems due to syntax template misuse
|
||||
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(eval
|
||||
'(module m racket/base
|
||||
(require racket/contract
|
||||
racket/unit)
|
||||
|
||||
(provide result)
|
||||
|
||||
(define-signature foo^
|
||||
[(contracted [foo (-> integer? ... integer?)])])
|
||||
|
||||
(define-unit foo@
|
||||
(import)
|
||||
(export foo^)
|
||||
(define (foo . xs) (apply + xs)))
|
||||
|
||||
(define (foo+1@ foo-base@)
|
||||
(define-values/invoke-unit foo-base@
|
||||
(import)
|
||||
(export (prefix base: foo^)))
|
||||
(unit
|
||||
(import)
|
||||
(export foo^)
|
||||
(define (foo . xs) (add1 (apply base:foo xs)))))
|
||||
|
||||
(define-values/invoke-unit (foo+1@ foo@)
|
||||
(import)
|
||||
(export foo^))
|
||||
|
||||
(define result (foo 1 2 3))))
|
||||
(test 7 (dynamic-require ''m 'result)))
|
||||
|
|
|
@ -46,13 +46,15 @@
|
|||
(syntax-case stx (set!)
|
||||
[x
|
||||
(identifier? #'x)
|
||||
#'#,(add-ctc i (bound-identifier-mapping-get
|
||||
member-table
|
||||
i))]
|
||||
(quote-syntax
|
||||
#,(add-ctc i (bound-identifier-mapping-get
|
||||
member-table
|
||||
i)))]
|
||||
[(x . y)
|
||||
#'(#,(add-ctc i (bound-identifier-mapping-get
|
||||
member-table
|
||||
i)) . y)])))])))
|
||||
(quote-syntax
|
||||
(#,(add-ctc i (bound-identifier-mapping-get
|
||||
member-table
|
||||
i)) . y))])))])))
|
||||
|
||||
(define-syntax (unit-export stx)
|
||||
(syntax-case stx ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user