suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: don't treat crashes as constract errors

Browse Source 
Converting "invalid memory reference" to an `exn:fail:contract` (which
is the default conversion) hides crashes as success when a test
expects an error.

Also, fix a bug that was hiding as an expected excdeption.
This commit is contained in:
Matthew Flatt 2018-11-21 09:26:43 -07:00
parent 701854a404
commit 7231f11b60
3 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/src/cs/rumble/bytes.ss
View File

@ -147,7 +147,7 @@
c))] c))]
[(a) [(a)
(check who bytes? a) (check who bytes? a)
(#2%bytevector-copy a)] (#3%bytevector-copy a)]
[() #vu8()] [() #vu8()]
[args [args
(let* ([size (let loop ([args args]) (let* ([size (let loop ([args args])

3
racket/src/cs/rumble/error.ss
View File

@ -682,6 +682,9 @@
(string=? "attempt to assign undefined variable ~s" (condition-message v)))) (string=? "attempt to assign undefined variable ~s" (condition-message v))))
(lambda (msg marks) (lambda (msg marks)
(|#%app| exn:fail:contract:variable msg marks (car (condition-irritants v))))] (|#%app| exn:fail:contract:variable msg marks (car (condition-irritants v))))]
[(and (format-condition? v)
(string-prefix? "~?. Some debugging context lost" (condition-message v)))
exn:fail]
[else [else
exn:fail:contract]) exn:fail:contract])
(exn->string v) (exn->string v)

8
racket/src/cs/rumble/procedure.ss
View File

@ -37,18 +37,18 @@
(case-lambda (case-lambda
[(proc args) [(proc args)
(if (#%procedure? proc) (if (#%procedure? proc)
(chez:apply proc args) (#2%apply proc args)
(chez:apply (extract-procedure proc (length args)) args))] (#2%apply (extract-procedure proc (length args)) args))]
[(proc) [(proc)
(raise-arity-error 'apply (|#%app| arity-at-least 2) proc)] (raise-arity-error 'apply (|#%app| arity-at-least 2) proc)]
[(proc . argss) [(proc . argss)
(if (#%procedure? proc) (if (#%procedure? proc)
(chez:apply chez:apply proc argss) (#2%apply #2%apply proc argss)
(let ([len (let loop ([argss argss]) (let ([len (let loop ([argss argss])
(cond (cond
[(null? (cdr argss)) (length (car argss))] [(null? (cdr argss)) (length (car argss))]
[else (fx+ 1 (loop (cdr argss)))]))]) [else (fx+ 1 (loop (cdr argss)))]))])
(chez:apply chez:apply (extract-procedure proc len) argss)))])) (#2%apply #2%apply (extract-procedure proc len) argss)))]))
;; See copy in "expander.sls" ;; See copy in "expander.sls"
(define-syntax (|#%app| stx) (define-syntax (|#%app| stx)