fix an identifier binding bug
Merge to 5.2
This commit is contained in:
parent
f704d1620d
commit
c514fd3470
|
@ -566,6 +566,42 @@
|
||||||
(q))))
|
(q))))
|
||||||
(require 'm-check-varref-expand)
|
(require 'm-check-varref-expand)
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Check that a modul-level binding with 0 marks
|
||||||
|
;; but lexical context is found correctly with
|
||||||
|
;; 1 and 2 marks (test case by Carl):
|
||||||
|
|
||||||
|
(module check-macro-introduced-via-defctx racket/base
|
||||||
|
(require (for-syntax racket/base racket/syntax))
|
||||||
|
|
||||||
|
(begin-for-syntax
|
||||||
|
(define env (box #false)))
|
||||||
|
|
||||||
|
(define-syntax (one stx)
|
||||||
|
(define ctx (syntax-local-make-definition-context #false))
|
||||||
|
(define id
|
||||||
|
(internal-definition-context-apply
|
||||||
|
ctx
|
||||||
|
(syntax-local-introduce (datum->syntax #false 'private))))
|
||||||
|
(syntax-local-bind-syntaxes (list id) #false ctx)
|
||||||
|
(internal-definition-context-seal ctx)
|
||||||
|
#`(begin
|
||||||
|
(begin-for-syntax (set-box! env #'#,id))
|
||||||
|
(define #,id #false)))
|
||||||
|
(one)
|
||||||
|
|
||||||
|
(define-syntax (two stx)
|
||||||
|
(define id ((make-syntax-introducer) (unbox env)))
|
||||||
|
(unless (free-identifier=? id (syntax-local-introduce id))
|
||||||
|
(raise-syntax-error
|
||||||
|
#false
|
||||||
|
(format "mark changes identifier's binding: ~v / ~v"
|
||||||
|
(identifier-binding id)
|
||||||
|
(identifier-binding (syntax-local-introduce id)))
|
||||||
|
id))
|
||||||
|
#'#f)
|
||||||
|
(two))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -1086,10 +1086,13 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (!SCHEME_PAIRP(marks)) {
|
if (SCHEME_NULLP(amarks)) {
|
||||||
|
/* can always match empty marks */
|
||||||
|
best_match = SCHEME_CDR(a);
|
||||||
|
best_match_skipped = 0;
|
||||||
|
} else if (!SCHEME_PAIRP(marks)) {
|
||||||
/* To be better than nothing, could only match exactly: */
|
/* To be better than nothing, could only match exactly: */
|
||||||
if (scheme_equal(amarks, marks)
|
if (scheme_equal(amarks, marks)) {
|
||||||
|| SCHEME_NULLP(amarks)) {
|
|
||||||
best_match = SCHEME_CDR(a);
|
best_match = SCHEME_CDR(a);
|
||||||
best_match_skipped = 0;
|
best_match_skipped = 0;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user