syntax/parse: add describe frame if opaque even if no description
fixes #2627 Also fix a bug where eh-alternatives were mistakenly marked opaque.
This commit is contained in:
parent
8f0fb72160
commit
cbfaf428d2
|
@ -341,3 +341,11 @@
|
|||
#:with w #'whatever
|
||||
#:fail-unless #f "message2" ;; (post 'g2 3), incomp w/ above
|
||||
'ok]))))
|
||||
|
||||
;; from Alexis King, #2627 (4/2019)
|
||||
(test-case "opaque ~describe w/o description is still opaque"
|
||||
(check-exn (lambda (e)
|
||||
(not (regexp-match? #rx"literal 0" (exn-message e))))
|
||||
(lambda ()
|
||||
(syntax-parse '(m #f)
|
||||
[(_ (~describe #:opaque #f 0)) 'ok]))))
|
||||
|
|
|
@ -1196,7 +1196,7 @@ Conventions:
|
|||
(define the-pattern (ehpat-head ehpat))
|
||||
(define attrs (iattrs->sattrs (pattern-attrs the-pattern)))
|
||||
(define the-variant (variant hstx attrs the-pattern null))
|
||||
(define the-rhs (rhs attrs #f #f (list the-variant) null #f #f))
|
||||
(define the-rhs (rhs attrs #t #f (list the-variant) null #f #f))
|
||||
(with-syntax ([(parser) (generate-temporaries '(eh-alt-parser))]
|
||||
[the-rhs-expr (datum->expression the-rhs)])
|
||||
(list (eh-alternative (ehpat-repc ehpat) attrs #'parser)
|
||||
|
|
|
@ -177,6 +177,7 @@ different purposes.
|
|||
|
||||
An ExpectStack (during parsing) is one of
|
||||
- (expect:thing Progress String Boolean String/#f ExpectStack)
|
||||
- (expect:thing Progress #f #f String/#f ExpectStack)
|
||||
* (expect:message String ExpectStack)
|
||||
* (expect:atom Datum ExpectStack)
|
||||
* (expect:literal Identifier ExpectStack)
|
||||
|
@ -229,7 +230,7 @@ RExpectList when the most specific information comes last.
|
|||
(expect:proper-pair? x)))
|
||||
|
||||
(define (es-add-thing ps description transparent? role next)
|
||||
(if (and next description)
|
||||
(if (and next (or description (not transparent?)))
|
||||
(expect:thing ps description transparent? role next)
|
||||
next))
|
||||
|
||||
|
|
|
@ -333,10 +333,11 @@ ie (ps->stx+index ps1) = (ps->stx+index ps2).
|
|||
['#f acc]
|
||||
['#t acc]
|
||||
[(expect:thing ps desc tr? role rest-es)
|
||||
(cond [(and truncate-opaque? (not tr?))
|
||||
(loop rest-es (cons (expect:thing #f desc #t role (ps->stx+index ps)) null))]
|
||||
[else
|
||||
(loop rest-es (cons (expect:thing #f desc tr? role (ps->stx+index ps)) acc))])]
|
||||
(let* (;; discard frames so far if opaque
|
||||
[acc (if (and truncate-opaque? (not tr?)) null acc)]
|
||||
;; discard this frame if desc is #f
|
||||
[acc (if desc (cons (expect:thing #f desc tr? role (ps->stx+index ps)) acc) acc)])
|
||||
(loop rest-es acc))]
|
||||
[(expect:message message rest-es)
|
||||
(loop rest-es (cons (expect:message message stx+index) acc))]
|
||||
[(expect:atom atom rest-es)
|
||||
|
|
Loading…
Reference in New Issue
Block a user