From 44c905cf88a4cec3614a185ec960c9eb049d7de0 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sun, 24 Mar 2013 18:34:46 -0700 Subject: [PATCH] Check for structure binding and raise good error if it is not there. Closes PR 13588. original commit: 87facb736fab1a79f064381433256f8b8a525688 --- collects/tests/typed-racket/fail/pr13588.rkt | 5 +++++ collects/typed-racket/base-env/prims.rkt | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) create mode 100644 collects/tests/typed-racket/fail/pr13588.rkt diff --git a/collects/tests/typed-racket/fail/pr13588.rkt b/collects/tests/typed-racket/fail/pr13588.rkt new file mode 100644 index 00000000..7d85f46e --- /dev/null +++ b/collects/tests/typed-racket/fail/pr13588.rkt @@ -0,0 +1,5 @@ +#; +(exn-pred #rx"identifier bound to a structure type") +#lang typed/racket/base +(require/typed racket/async-channel + [#:struct (async-channel +) ()]) diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index fd0d95bf..44816fd7 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -628,6 +628,10 @@ This file defines two sorts of primitives. All of them are provided into any mod [extra-maker (and (attribute input-maker.extra) (not (bound-identifier=? #'make-name #'nm)) #'maker-name)]) + (define (extract-struct-info* id) + (syntax-parse id #:context stx + [(~var id (static struct-info? "identifier bound to a structure type")) + (extract-struct-info (syntax-local-value #'parent))])) (quasisyntax/loc stx (begin (require (only-in lib type-des (nm orig-struct-info))) @@ -652,7 +656,7 @@ This file defines two sorts of primitives. All of them are provided into any mod #,(if (syntax-e #'parent) (let-values (((parent-type-des parent-maker parent-pred parent-sel parent-mut grand-parent) - (apply values (extract-struct-info (syntax-local-value #'parent))))) + (apply values (extract-struct-info* #'parent)))) #`(list (quote-syntax type-des) (quote-syntax real-maker) (quote-syntax pred)