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

Improve error message for misuse of type names

Browse Source 
Closes PR 13289
This commit is contained in:
Asumu Takikawa 2013-09-19 23:48:22 -04:00
parent 5097610252
commit cd004fd9ce
5 changed files with 27 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types-extra.rkt
View File

@ -1,13 +1,16 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base syntax/stx))
(define-syntax (define-other-types stx) (define-syntax (define-other-types stx)
(syntax-case stx () (syntax-case stx ()
[(_ nm ...) [(_ nm ...)
#'(begin (define-syntax nm #'(begin (define-syntax nm
(lambda (stx) (lambda (stx)
(raise-syntax-error 'type-check "type name used out of context" stx))) ... (raise-syntax-error 'type-check "type name used out of context"
stx
(and (stx-pair? stx) (stx-car stx)))))
...
(provide nm) ...)])) (provide nm) ...)]))
;; special type names that are not bound to particular types ;; special type names that are not bound to particular types

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/extra-procs.rkt
View File

@ -7,7 +7,7 @@
(or v (error (format "Assertion failed on ~v" v)))) (or v (error (format "Assertion failed on ~v" v))))
((assert v pred) ((assert v pred)
(let ((val v)) (let ((val v))
(if (pred val) (if ((#%expression pred) val)
val val
(error (format "Assertion ~a failed on ~v" pred val))))))) (error (format "Assertion ~a failed on ~v" pred val)))))))

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

@ -499,7 +499,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
([omit #f]))) ([omit #f])))
#`(begin #`(begin
#,(if (not (attribute omit)) #,(if (not (attribute omit))
(ignore #'(define-syntax tname (lambda (stx) (raise-syntax-error 'type-check "type name used out of context" stx)))) (ignore #'(define-syntax tname
(lambda (stx)
(raise-syntax-error
'type-check
"type name used out of context"
stx
(and (stx-pair? stx) (stx-car stx))))))
#'(begin)) #'(begin))
#,(internal (syntax/loc stx (define-type-alias-internal tname rest))))] #,(internal (syntax/loc stx (define-type-alias-internal tname rest))))]
[(_ (tname:id args:id ...) rest) [(_ (tname:id args:id ...) rest)

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

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base syntax/parse)) (require (for-syntax racket/base syntax/parse syntax/stx))
(define-syntax (#%module-begin stx) (define-syntax (#%module-begin stx)
(syntax-parse stx #:literals (require) (syntax-parse stx #:literals (require)
@ -9,7 +9,9 @@
(begin (begin
(define-syntax (nm stx) (define-syntax (nm stx)
(raise-syntax-error (raise-syntax-error
'type-check "type name used out of context" stx)) 'type-check "type name used out of context"
stx
(and (stx-pair? stx) (stx-car stx))))
... ...
(provide nm) ... (provide nm) ...
(begin-for-syntax (begin-for-syntax

10
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/pr13289.rkt Normal file
View File

@ -0,0 +1,10 @@
#;
(exn-pred #rx"fail/pr13289.rkt:9:10:.*in: Natural")
#lang typed/racket
;; This test ensures that the error message for misuse of
;; type names has a source location and reports with the correct
;; syntax
(assert 2 Natural)