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:
Ryan Culpepper 2019-04-28 00:35:22 +02:00
parent 8f0fb72160
commit cbfaf428d2
4 changed files with 16 additions and 6 deletions

View File

@ -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]))))

View File

@ -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)

View File

@ -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))

View File

@ -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)