From 38f85dce575151355a742227c159f2a312666408 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Wed, 7 Sep 2005 18:33:23 +0000 Subject: [PATCH] Fix to catching exceptions svn: r786 --- collects/profj/check.ss | 9 ++++++--- collects/profj/libs/java/lang/Throwable.jinfo | 2 +- collects/profj/to-scheme.ss | 18 ++++++++++++++---- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/collects/profj/check.ss b/collects/profj/check.ss index 0def6c1af0..1087ab8d1f 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -1142,12 +1142,15 @@ (if (null? catches) new-env (let* ((catch (car catches)) - (type (field-type-spec (catch-cond catch)))) + (type (type-spec-to-type (field-type-spec (catch-cond catch)) #f 'full type-recs))) (unless (and (ref-type? type) (is-eq-subclass? type throw-type type-recs)) (catch-error type (field-src (catch-cond catch)))) + (set-field-type! (catch-cond catch) type) + (add-required '("" "") (ref-type-class/iface type) (ref-type-path type) type-recs) (loop (cdr catches) (add-exn-to-env type env)))))) (body-res (check-s body new-env))) + (add-required '("" "") "Throwable" '("java" "lang") type-recs) (for-each (lambda (catch) (let* ((field (catch-cond catch)) (name (id-string (field-name field))) @@ -1155,10 +1158,10 @@ (if (and in-env? (not (properties-field? (var-type-properties in-env?)))) (illegal-redefinition (field-name field) (field-src field)) (check-s (catch-body catch) - (add-var-to-env name (field-type-spec field) parm env))))) + (add-var-to-env name (field-type field) parm env))))) catches) (when finally (check-s finally env)) - (make-type/env 'void (unnest-var (type/env-e body-res))))) + (make-type/env 'void (unnest-var env (type/env-e body-res))))) ;INCORRECT!!! This doesn't properly type check and I'm just raising an error for now ;Skipping proper checks of the statements + proper checking that constants aren't repeated diff --git a/collects/profj/libs/java/lang/Throwable.jinfo b/collects/profj/libs/java/lang/Throwable.jinfo index c5920eb6bb..27f6884005 100644 --- a/collects/profj/libs/java/lang/Throwable.jinfo +++ b/collects/profj/libs/java/lang/Throwable.jinfo @@ -14,7 +14,7 @@ ("getMessage" (public) ("String" "java" "lang") () () ("Throwable" "java" "lang")) ("getStackTrace" (public) (1 ("StackTraceElement" "java" "lang")) () () ("Throwable" "java" "lang")) ("printStackTrace" (public) void () () ("Throwable" "java" "lang")) - ("printStackTrace" (public) void (("PrintString" "java" "io")) () ("Throwable" "java" "lang")) + ("printStackTrace" (public) void (("PrintStream" "java" "io")) () ("Throwable" "java" "lang")) ("printStackTrace" (public) void (("PrintWriter" "java" "io")) () ("Throwable" "java" "lang")) ("setStackTrace" (public) void ((1 ("StackTraceElement" "java" "lang"))) () ("Throwable" "java" "lang")) ;("toString" (public) ("String" "java" "lang") () () ("Throwable" "java" "lang")) diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index 18966aa72b..1918bc271d 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -542,7 +542,7 @@ ((null? reqs) null) ((member (cadr (car reqs)) (list (make-req "Class" '("java" "lang")) - (make-req "PrintString" '("java" "io")) + (make-req "PrintStream" '("java" "io")) (make-req "PrintWriter" '("java" "io")))) (translate-require (cdr reqs) type-recs)) (else @@ -932,7 +932,10 @@ (cond ((and (equal? string-type type) from-dynamic?) `(make-java-string ,value)) ((equal? string-type type) `(send ,value get-mzscheme-string)) - ((equal? type (make-ref-type "Class" '("java" "lang"))) value) + ((member type (list + (make-ref-type "Class" '("java" "lang")) + (make-ref-type "PrintStream" '("java" "io")) + (make-ref-type "PrintWriter" '("java" "io")))) value) (from-dynamic? `(,(build-identifier (string-append "wrap-convert-assert-" (ref-type-class/iface type))) ,value pos-blame neg-blame src cc-marks)) (else `(make-object ,(build-identifier (string-append "guard-convert-" (ref-type-class/iface type))) @@ -1714,7 +1717,7 @@ (if isRuntime? (make-syntax #f `exn? (build-src var-src)) (make-syntax #f - `(javaException:exception-is-a? ,class-name) + `(exception-is-a? ,class-name) (build-src var-src)))) (parm (translate-id (build-var-name (id-string (field-name catch-var))) (id-src (field-name catch-var)))) @@ -2624,7 +2627,14 @@ (build-identifier (var-access-class vaccess)))))) ((not obj) (set-h (translate-id (build-var-name field) field-src))) (else - (let ((setter (create-set-name field (var-access-class vaccess))) + (let ((setter (if (var-access-final? vaccess) + (make-syntax #f + `(lambda (my-dummy new-val) + ((class-field-mutator ,(build-identifier (var-access-class vaccess)) + ,(build-identifier field)) + this new-val)) + #f) + (create-set-name field (var-access-class vaccess)))) (getter (create-get-name field (var-access-class vaccess))) (name (gensym 'field-obj)) (new-val (gensym 'val)))