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

Close holes in what values can be thrown.

Browse Source 
- Don't allow 3d-syntax in the exprs field of `exn:fail:syntax`
- Don't allow throwing arbitrary higher-order values
This commit is contained in:
Sam Tobin-Hochstadt 2014-07-29 23:56:03 -07:00
parent 597c62949b
commit 9eaae1f93e
4 changed files with 17 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt
View File

@ -20,7 +20,7 @@
"base-structs.rkt" "base-structs.rkt"
racket/file racket/file
(only-in racket/private/pre-base new-apply-proc) (only-in racket/private/pre-base new-apply-proc)
(only-in (types abbrev) [-Boolean B] [-Symbol Sym]) (only-in (types abbrev) [-Boolean B] [-Symbol Sym] -Flat)
(only-in (types numeric-tower) [-Number N]) (only-in (types numeric-tower) [-Number N])
(only-in (rep type-rep) (only-in (rep type-rep)
make-ClassTop make-ClassTop
@ -1146,8 +1146,8 @@
((-> ManyUniv) ((list) Univ . ->* . b) . -> . b)))] ((-> ManyUniv) ((list) Univ . ->* . b) . -> . b)))]
;; Section 10.2 ;; Section 10.2
[raise (cl->* (Univ . -> . (Un)) [raise (cl->* ((Un -Flat -Exn) . -> . (Un))
(Univ Univ . -> . (Un)))] ((Un -Flat -Exn) Univ . -> . (Un)))]
[error [error
(cl->* (-> Sym (Un)) (cl->* (-> Sym (Un))
(->* (list -String) Univ (Un)) (->* (list -String) Univ (Un))

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-structs.rkt
View File

@ -10,7 +10,7 @@
(require (for-template racket/base (prefix-in k: '#%kernel))) (require (for-template racket/base (prefix-in k: '#%kernel)))
(provide initialize-structs -Date -Srcloc -Date -Arity-At-Least) (provide initialize-structs -Date -Srcloc -Date -Arity-At-Least -Exn)
(define-syntax define-hierarchy (define-syntax define-hierarchy
(syntax-rules (define-hierarchy) (syntax-rules (define-hierarchy)
@ -82,7 +82,7 @@
(define-hierarchy exn:fail:contract:continuation (#:kernel-maker k:exn:fail:contract:continuation) ()) (define-hierarchy exn:fail:contract:continuation (#:kernel-maker k:exn:fail:contract:continuation) ())
(define-hierarchy exn:fail:contract:variable (#:kernel-maker k:exn:fail:contract:variable) ())) (define-hierarchy exn:fail:contract:variable (#:kernel-maker k:exn:fail:contract:variable) ()))
(define-hierarchy exn:fail:syntax (#:kernel-maker k:exn:fail:syntax) ([exprs : (-lst (-Syntax Univ))])) (define-hierarchy exn:fail:syntax (#:kernel-maker k:exn:fail:syntax) ([exprs : (-lst Any-Syntax)]))
(define-hierarchy exn:fail:read (#:kernel-maker k:exn:fail:read) (define-hierarchy exn:fail:read (#:kernel-maker k:exn:fail:read)
([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc ([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt
View File

@ -164,6 +164,10 @@
(make-Vector sexp) (make-Vector sexp)
(make-Box sexp) (make-Box sexp)
t))) t)))
(define/decl -Flat
(-mu flat
(Un -Null -Number -Boolean -Symbol -String -Keyword -Char
(-pair flat flat))))
(define/decl -Sexp (-Sexpof (Un))) (define/decl -Sexp (-Sexpof (Un)))
(define Syntax-Sexp (-Sexpof Any-Syntax)) (define Syntax-Sexp (-Sexpof Any-Syntax))
(define Ident (-Syntax -Symbol)) (define Ident (-Syntax -Symbol))

8
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -3175,6 +3175,14 @@
(raise 'foo)) (raise 'foo))
#:ret (ret -String) #:ret (ret -String)
#:msg #rx"expected: Symbol.*given: Any"] #:msg #rx"expected: Symbol.*given: Any"]
[tc-err
(raise (λ ([x : Number]) (add1 x)))
#:ret (ret (Un))]
[tc-err
(exn:fail:syntax "" (current-continuation-marks) (list (datum->syntax #f add1)))
#:ret (ret -Exn)]
;; PR 14218 ;; PR 14218
[tc-e (ann (values "foo" "bar") (Values String String)) [tc-e (ann (values "foo" "bar") (Values String String))