From 08b57461d74517e2c5b5ab104f691c2fad8ef309 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Mon, 12 Dec 2005 23:54:14 +0000 Subject: [PATCH] Corrected immutable string bug, and refined bug fix for casts svn: r1604 --- collects/profj/doc.txt | 15 ++++++++++ .../profj/libs/java/lang/Object-composite.ss | 30 +++++++++---------- collects/profj/libs/java/runtime.scm | 6 ++-- collects/profj/to-scheme.ss | 17 ++++++----- collects/tests/profj/full-tests.ss | 7 +++++ 5 files changed, 51 insertions(+), 24 deletions(-) diff --git a/collects/profj/doc.txt b/collects/profj/doc.txt index dd6c13728b..3f1643ac72 100644 --- a/collects/profj/doc.txt +++ b/collects/profj/doc.txt @@ -90,6 +90,21 @@ _Java + dynamic_ language level JName.*[%] <-> Jname.*[Obj] i.e. object% <-> objectObj +Known bugs for dynamic: + Programs of the following form will not produce the expected result: + Object o = new Object(); + dynamic x = o; + boolean t = x == o; + In this program, t will have the value false, not true as expected. + Some casts will fail and instanceof's return false that aught to succeed: + interface I { } + class C implements I { } + I ic = new C(); + dynamic x = ic; + C c = (C) x; + In this program, the cast of x to C will fail, even though the value is an intstanceof C. + These issues will be addressed in future versions. + _Libraries available to ProfessorJ: java.lang.Object diff --git a/collects/profj/libs/java/lang/Object-composite.ss b/collects/profj/libs/java/lang/Object-composite.ss index 2c1e90b548..950ad2c114 100644 --- a/collects/profj/libs/java/lang/Object-composite.ss +++ b/collects/profj/libs/java/lang/Object-composite.ss @@ -935,24 +935,24 @@ (define (wrap-convert-assert-Throwable obj p n s c) (c:contract (c:object-contract - (initCause (c:-> c:any/c c:any/c)) - (getMessage (c:-> c:any/c)) - (getCause (c:-> c:any/c)) - (getLocalizedMessage (c:-> c:any/c)) + (init-cause (c:-> c:any/c c:any/c)) + (get-message (c:-> c:any/c)) + (get-cause (c:-> c:any/c)) + (get-localized-message (c:-> c:any/c)) (setStackTrace-java.lang.StackTraceElement1 (c:-> c:any/c c:any/c)) - (getStackTrace (c:-> c:any/c)) + (get-stack-trace (c:-> c:any/c)) (printStackTrace (c:-> c:any/c)) - (printStackTrace-PrintStream (c:-> c:any/c)) - (printStackTrace-PrintWriter (c:-> c:any/c)) - (fillInStackTrace (c:-> c:any/c)) + (printStackTrace-PrintStream (c:-> c:any/c c:any/c)) + (printStackTrace-PrintWriter (c:-> c:any/c c:any/c)) + (fill-in-stack-trace (c:-> c:any/c)) (clone (c:-> c:any/c)) (equals-java.lang.Object (c:-> c:any/c c:any/c)) (finalize (c:-> c:any/c)) - (getClass (c:-> c:any/c)) - (hashCode (c:-> c:any/c)) + (get-class (c:-> c:any/c)) + (hash-code (c:-> c:any/c)) (notify (c:-> c:any/c)) - (notifyAll (c:-> c:any/c)) - (toString (c:-> c:any/c)) + (notify-all (c:-> c:any/c)) + (to-string (c:-> c:any/c)) (wait (c:-> c:any/c)) (wait-long (c:-> c:any/c c:any/c)) (wait-long-int (c:-> c:any/c c:any/c c:any/c))) obj p n s) @@ -1053,12 +1053,12 @@ (define/public (getStackTrace) (send wrapped getStackTrace)) (define/public (get-stack-trace) (send wrapped getStackTrace)) (define/public (printStackTrace) (send wrapped printStackTrace)) - (define/public (printStackTrace-PrintStream printStream) (send wrapped printStackTrace-PrintStream)) - (define/public (printStackTrace-PrintWriter pW) (send wrapped printStackTrace-PrintWriter)) + (define/public (printStackTrace-PrintStream printStream) (send wrapped printStackTrace-PrintStream printStream)) + (define/public (printStackTrace-PrintWriter pW) (send wrapped printStackTrace-PrintWriter pW)) (define/public (fillInStackTrace) (send wrapped fillInStackTrace)) (define/public (fill-in-stack-trace) (send wrapped fillInStackTrace)) - (super-instantiate ()))) + )) (define static-Throwable/c (c:flat-named-contract "Throwable" (lambda (v) (is-a? v guard-convert-Throwable)))) diff --git a/collects/profj/libs/java/runtime.scm b/collects/profj/libs/java/runtime.scm index e839006fa9..baf45585dd 100644 --- a/collects/profj/libs/java/runtime.scm +++ b/collects/profj/libs/java/runtime.scm @@ -143,8 +143,8 @@ (else (raise-class-cast (format "Cast to ~a failed for ~a" type (send (convert-to-string val) get-mzscheme-string))))))))) - ;cast-reference: value class int symbol-> value - (define (cast-reference val type dim name) + ;cast-reference: value class class class int symbol-> value + (define (cast-reference val type ca-type gc-type dim name) (if (> dim 0) (if (send val check-ref-type type dim) val @@ -152,6 +152,8 @@ (format "Cast to ~a~a failed for ~a" name (make-brackets dim) (send (convert-to-string val) get-mzscheme-string)))) (cond ((and (eq? Object type) (is-a? val ObjectI)) val) + ((and (is-a? val convert-assert-Object) (is-a? val ca-type)) val) + ((and (is-a? val guard-convert-Object) (is-a? val gc-type)) val) ((is-a? val type) val) (else (raise-class-cast (format "Cast to ~a failed for ~a" name (send val my-name))))))) diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index 6892749c90..43936e4f3d 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -763,8 +763,9 @@ (let ((raise-error (lambda (method-name num-args) (raise (make-exn:fail - (format "~a broke the contract with ~a here, expected an object with a method ~a accepting ~a args" - n p method-name num-args) s))))) + (string->immutable-string + (format "~a broke the contract with ~a here, expected an object with a method ~a accepting ~a args" + n p method-name num-args)) s))))) (and ,@(map method->check/error (filter (lambda (m) (not (eq? 'ctor (method-record-rtype m)))) wrapped-methods)))) #;(c:contract ,(methods->contract (filter (lambda (m) (not (eq? 'ctor (method-record-rtype m)))) @@ -2533,7 +2534,6 @@ ((+) expr)) (build-src src)))) - ;converted ;translate-cast: type-spec syntax type src (define (translate-cast type expr expr-type src) (cond @@ -2549,10 +2549,13 @@ (make-syntax #f `(javaRuntime:cast-primitive ,expr (quote ,(type-spec-name type)) ,(type-spec-dim type)) (build-src src))) (else - (make-syntax #f `(javaRuntime:cast-reference ,expr ,(get-class-name type) - ,(type-spec-dim type) - (quote ,(get-class-name type))) - (build-src src))))) + (let* ((class (get-class-name type)) + (ca-class (string->symbol (format "convert-assert-~a" (syntax-object->datum class)))) + (gc-class (string->symbol (format "guard-convert-~a" (syntax-object->datum class))))) + (make-syntax #f `(javaRuntime:cast-reference ,expr ,class ,ca-class ,gc-class + ,(type-spec-dim type) + (quote ,(get-class-name type))) + (build-src src)))))) ;translate-instanceof: syntax type-spec src -> syntax (define (translate-instanceof expr type src) diff --git a/collects/tests/profj/full-tests.ss b/collects/tests/profj/full-tests.ss index b944d00090..59245a5171 100644 --- a/collects/tests/profj/full-tests.ss +++ b/collects/tests/profj/full-tests.ss @@ -4,6 +4,13 @@ (prepare-for-tests "Full") + (parameterize ((dynamic? #t)) + (interact-test "class A { }" + 'full + '("dynamic x = new A();" "A a = x;" "(A) a") + '((void) (void) a~f) + "Casting a guarded/asserted value back to the original type")) + (parameterize ((dynamic? #t)) (interact-test "interface I { int m( int x); }