parent
09b61f06c1
commit
bf4fb553b3
|
@ -383,6 +383,10 @@ record, else the @racket[expr] is used if provided and not
|
||||||
@racket[extra-sources] to produce the @racket[exprs] field, or
|
@racket[extra-sources] to produce the @racket[exprs] field, or
|
||||||
@racket[extra-sources] is used directly for @racket[exprs] if neither
|
@racket[extra-sources] is used directly for @racket[exprs] if neither
|
||||||
@racket[expr] nor @racket[sub-expr] is provided and not @racket[#f].
|
@racket[expr] nor @racket[sub-expr] is provided and not @racket[#f].
|
||||||
|
The @racket[extra-sources] argument is also used directly for
|
||||||
|
@racket[exprs] in the unusual case that the @racket[sub-expr] or
|
||||||
|
@racket[expr] that would be included in @racket[exprs] cannot be
|
||||||
|
converted to a syntax object (because it contains a cycle).
|
||||||
|
|
||||||
The form name used in the generated error message is determined
|
The form name used in the generated error message is determined
|
||||||
through a combination of the @racket[name], @racket[expr], and
|
through a combination of the @racket[name], @racket[expr], and
|
||||||
|
|
|
@ -2481,6 +2481,20 @@
|
||||||
(check stx #f)
|
(check stx #f)
|
||||||
(check #f a-stx))
|
(check #f a-stx))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Check that `raise-syntax-error` forges ahead even if
|
||||||
|
;; it's given a cyclic S-expression
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
(define v (vector #f))
|
||||||
|
(vector-set! v 0 v)
|
||||||
|
(define (check-err v v-detail)
|
||||||
|
(err/rt-test (raise-syntax-error 'something "" v v-detail)
|
||||||
|
exn:fail:syntax?
|
||||||
|
#rx"^something: .*#0=#[(]#0#[)]"))
|
||||||
|
(check-err v #f)
|
||||||
|
(check-err 'bad v))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Test prop:rename-transformer with procedure content
|
;; Test prop:rename-transformer with procedure content
|
||||||
|
|
||||||
|
|
|
@ -13803,9 +13803,7 @@ static const char *startup_source =
|
||||||
"(let-values(((or-part_0)"
|
"(let-values(((or-part_0)"
|
||||||
"(if sub-expr_0"
|
"(if sub-expr_0"
|
||||||
"(if(error-print-source-location)"
|
"(if(error-print-source-location)"
|
||||||
"(format"
|
" (format \"\\n at: ~.s\" (->datum sub-expr_0))"
|
||||||
" \"\\n at: ~.s\""
|
|
||||||
"(syntax->datum$1(datum->syntax$1 #f sub-expr_0)))"
|
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f)))"
|
" #f)))"
|
||||||
" (if or-part_0 or-part_0 \"\"))))"
|
" (if or-part_0 or-part_0 \"\"))))"
|
||||||
|
@ -13813,7 +13811,7 @@ static const char *startup_source =
|
||||||
"(let-values(((or-part_0)"
|
"(let-values(((or-part_0)"
|
||||||
"(if expr_0"
|
"(if expr_0"
|
||||||
"(if(error-print-source-location)"
|
"(if(error-print-source-location)"
|
||||||
" (format \"\\n in: ~.s\" (syntax->datum$1 (datum->syntax$1 #f expr_0)))"
|
" (format \"\\n in: ~.s\" (->datum expr_0))"
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f)))"
|
" #f)))"
|
||||||
" (if or-part_0 or-part_0 \"\"))))"
|
" (if or-part_0 or-part_0 \"\"))))"
|
||||||
|
@ -13839,11 +13837,23 @@ static const char *startup_source =
|
||||||
"(map2"
|
"(map2"
|
||||||
" syntax-taint$1"
|
" syntax-taint$1"
|
||||||
"(if(let-values(((or-part_0) sub-expr_0))(if or-part_0 or-part_0 expr_0))"
|
"(if(let-values(((or-part_0) sub-expr_0))(if or-part_0 or-part_0 expr_0))"
|
||||||
|
"(let-values(((with-handlers-predicate17_0) exn:fail:contract?)"
|
||||||
|
"((with-handlers-handler18_0)"
|
||||||
|
"(lambda(exn_0)(begin 'with-handlers-handler18 extra-sources_0))))"
|
||||||
|
"(let-values(((bpz_0)(continuation-mark-set-first #f break-enabled-key)))"
|
||||||
|
"(call-handled-body"
|
||||||
|
" bpz_0"
|
||||||
|
"(lambda(e_0)"
|
||||||
|
"(select-handler/no-breaks"
|
||||||
|
" e_0"
|
||||||
|
" bpz_0"
|
||||||
|
"(list(cons with-handlers-predicate17_0 with-handlers-handler18_0))))"
|
||||||
|
"(lambda()"
|
||||||
"(cons"
|
"(cons"
|
||||||
"(datum->syntax$1"
|
"(datum->syntax$1"
|
||||||
" #f"
|
" #f"
|
||||||
"(let-values(((or-part_0) sub-expr_0))(if or-part_0 or-part_0 expr_0)))"
|
"(let-values(((or-part_0) sub-expr_0))(if or-part_0 or-part_0 expr_0)))"
|
||||||
" extra-sources_0)"
|
" extra-sources_0)))))"
|
||||||
" extra-sources_0))))))))))))))))"
|
" extra-sources_0))))))))))))))))"
|
||||||
"(define-values"
|
"(define-values"
|
||||||
"(extract-form-name)"
|
"(extract-form-name)"
|
||||||
|
@ -13867,6 +13877,18 @@ static const char *startup_source =
|
||||||
" (let-values (((str_0) (srcloc->string (syntax-srcloc s_0)))) (if str_0 (string-append str_0 \": \") #f))"
|
" (let-values (((str_0) (srcloc->string (syntax-srcloc s_0)))) (if str_0 (string-append str_0 \": \") #f))"
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f))))"
|
" #f))))"
|
||||||
|
"(define-values"
|
||||||
|
"(->datum)"
|
||||||
|
"(lambda(expr_0)"
|
||||||
|
"(begin"
|
||||||
|
"(let-values(((with-handlers-predicate19_0) exn:fail:contract?)"
|
||||||
|
"((with-handlers-handler20_0)(lambda(exn_0)(begin 'with-handlers-handler20 expr_0))))"
|
||||||
|
"(let-values(((bpz_0)(continuation-mark-set-first #f break-enabled-key)))"
|
||||||
|
"(call-handled-body"
|
||||||
|
" bpz_0"
|
||||||
|
"(lambda(e_0)"
|
||||||
|
"(select-handler/no-breaks e_0 bpz_0(list(cons with-handlers-predicate19_0 with-handlers-handler20_0))))"
|
||||||
|
"(lambda()(syntax->datum$1(datum->syntax$1 #f expr_0)))))))))"
|
||||||
"(define-values(current-previously-unbound)(lambda()(begin #f)))"
|
"(define-values(current-previously-unbound)(lambda()(begin #f)))"
|
||||||
"(define-values(set-current-previously-unbound!)(lambda(proc_0)(begin(set! current-previously-unbound proc_0))))"
|
"(define-values(set-current-previously-unbound!)(lambda(proc_0)(begin(set! current-previously-unbound proc_0))))"
|
||||||
"(define-values"
|
"(define-values"
|
||||||
|
|
|
@ -16588,10 +16588,7 @@
|
||||||
(let ((or-part_0
|
(let ((or-part_0
|
||||||
(if sub-expr_0
|
(if sub-expr_0
|
||||||
(if (error-print-source-location)
|
(if (error-print-source-location)
|
||||||
(format
|
(format "\n at: ~.s" (->datum sub-expr_0))
|
||||||
"\n at: ~.s"
|
|
||||||
(syntax->datum$1
|
|
||||||
(datum->syntax$1 #f sub-expr_0)))
|
|
||||||
#f)
|
#f)
|
||||||
#f)))
|
#f)))
|
||||||
(if or-part_0 or-part_0 ""))))
|
(if or-part_0 or-part_0 ""))))
|
||||||
|
@ -16599,10 +16596,7 @@
|
||||||
(let ((or-part_0
|
(let ((or-part_0
|
||||||
(if expr_0
|
(if expr_0
|
||||||
(if (error-print-source-location)
|
(if (error-print-source-location)
|
||||||
(format
|
(format "\n in: ~.s" (->datum expr_0))
|
||||||
"\n in: ~.s"
|
|
||||||
(syntax->datum$1
|
|
||||||
(datum->syntax$1 #f expr_0)))
|
|
||||||
#f)
|
#f)
|
||||||
#f)))
|
#f)))
|
||||||
(if or-part_0 or-part_0 ""))))
|
(if or-part_0 or-part_0 ""))))
|
||||||
|
@ -16636,11 +16630,31 @@
|
||||||
(map_1346
|
(map_1346
|
||||||
syntax-taint$1
|
syntax-taint$1
|
||||||
(if (if sub-expr_0 sub-expr_0 expr_0)
|
(if (if sub-expr_0 sub-expr_0 expr_0)
|
||||||
(cons
|
(let ((with-handlers-handler18_0
|
||||||
(datum->syntax$1
|
(|#%name|
|
||||||
#f
|
with-handlers-handler18
|
||||||
(if sub-expr_0 sub-expr_0 expr_0))
|
(lambda (exn_0)
|
||||||
extra-sources_0)
|
(begin extra-sources_0)))))
|
||||||
|
(let ((bpz_0
|
||||||
|
(continuation-mark-set-first
|
||||||
|
#f
|
||||||
|
break-enabled-key)))
|
||||||
|
(call-handled-body
|
||||||
|
bpz_0
|
||||||
|
(lambda (e_0)
|
||||||
|
(select-handler/no-breaks
|
||||||
|
e_0
|
||||||
|
bpz_0
|
||||||
|
(list
|
||||||
|
(cons
|
||||||
|
exn:fail:contract?
|
||||||
|
with-handlers-handler18_0))))
|
||||||
|
(lambda ()
|
||||||
|
(cons
|
||||||
|
(datum->syntax$1
|
||||||
|
#f
|
||||||
|
(if sub-expr_0 sub-expr_0 expr_0))
|
||||||
|
extra-sources_0)))))
|
||||||
extra-sources_0)))))))))))))))))
|
extra-sources_0)))))))))))))))))
|
||||||
(define extract-form-name
|
(define extract-form-name
|
||||||
(lambda (s_0)
|
(lambda (s_0)
|
||||||
|
@ -16660,6 +16674,19 @@
|
||||||
(if str_0 (string-append str_0 ": ") #f))
|
(if str_0 (string-append str_0 ": ") #f))
|
||||||
#f)
|
#f)
|
||||||
#f)))
|
#f)))
|
||||||
|
(define ->datum
|
||||||
|
(lambda (expr_0)
|
||||||
|
(let ((with-handlers-handler20_0
|
||||||
|
(|#%name| with-handlers-handler20 (lambda (exn_0) (begin expr_0)))))
|
||||||
|
(let ((bpz_0 (continuation-mark-set-first #f break-enabled-key)))
|
||||||
|
(call-handled-body
|
||||||
|
bpz_0
|
||||||
|
(lambda (e_0)
|
||||||
|
(select-handler/no-breaks
|
||||||
|
e_0
|
||||||
|
bpz_0
|
||||||
|
(list (cons exn:fail:contract? with-handlers-handler20_0))))
|
||||||
|
(lambda () (syntax->datum$1 (datum->syntax$1 #f expr_0))))))))
|
||||||
(define current-previously-unbound (lambda () #f))
|
(define current-previously-unbound (lambda () #f))
|
||||||
(define set-current-previously-unbound!
|
(define set-current-previously-unbound!
|
||||||
(lambda (proc_0) (set! current-previously-unbound proc_0)))
|
(lambda (proc_0) (set! current-previously-unbound proc_0)))
|
||||||
|
|
|
@ -75,12 +75,12 @@
|
||||||
(define at-message
|
(define at-message
|
||||||
(or (and sub-expr
|
(or (and sub-expr
|
||||||
(error-print-source-location)
|
(error-print-source-location)
|
||||||
(format "\n at: ~.s" (syntax->datum (datum->syntax #f sub-expr))))
|
(format "\n at: ~.s" (->datum sub-expr)))
|
||||||
""))
|
""))
|
||||||
(define in-message
|
(define in-message
|
||||||
(or (and expr
|
(or (and expr
|
||||||
(error-print-source-location)
|
(error-print-source-location)
|
||||||
(format "\n in: ~.s" (syntax->datum (datum->syntax #f expr))))
|
(format "\n in: ~.s" (->datum expr)))
|
||||||
""))
|
""))
|
||||||
(define src-loc-str
|
(define src-loc-str
|
||||||
(or (and (error-print-source-location)
|
(or (and (error-print-source-location)
|
||||||
|
@ -98,8 +98,10 @@
|
||||||
(current-continuation-marks)
|
(current-continuation-marks)
|
||||||
(map syntax-taint
|
(map syntax-taint
|
||||||
(if (or sub-expr expr)
|
(if (or sub-expr expr)
|
||||||
(cons (datum->syntax #f (or sub-expr expr))
|
;; accomodate `datum->syntax` failure similar to `->datum`:
|
||||||
extra-sources)
|
(with-handlers ([exn:fail:contract? (lambda (exn) extra-sources)])
|
||||||
|
(cons (datum->syntax #f (or sub-expr expr))
|
||||||
|
extra-sources))
|
||||||
extra-sources)))))
|
extra-sources)))))
|
||||||
|
|
||||||
(define (extract-form-name s)
|
(define (extract-form-name s)
|
||||||
|
@ -121,6 +123,16 @@
|
||||||
(and str
|
(and str
|
||||||
(string-append str ": ")))))
|
(string-append str ": ")))))
|
||||||
|
|
||||||
|
;; `raise-syntax-error` is meant to accept either syntax objects or
|
||||||
|
;; S-expressions, and it has traditionally supported hybird values by
|
||||||
|
;; coercing to a syntax object and them back; in case the expression
|
||||||
|
;; cannot be represented as a syntax object due to cycles, though,
|
||||||
|
;; fall back to showing the value in raw form (instead of constraining
|
||||||
|
;; `raise-syntax-error`)
|
||||||
|
(define (->datum expr)
|
||||||
|
(with-handlers ([exn:fail:contract? (lambda (exn) expr)])
|
||||||
|
(syntax->datum (datum->syntax #f expr))))
|
||||||
|
|
||||||
;; Hook for the expander:
|
;; Hook for the expander:
|
||||||
(define current-previously-unbound (lambda () #f))
|
(define current-previously-unbound (lambda () #f))
|
||||||
(define (set-current-previously-unbound! proc)
|
(define (set-current-previously-unbound! proc)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user