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

Corrected immutable string bug, and refined bug fix for casts

Browse Source 
svn: r1604
This commit is contained in:
Kathy Gray 2005-12-12 23:54:14 +00:00
parent 5b1f62332d
commit 08b57461d7
5 changed files with 51 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/profj/doc.txt
View File

@ -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

30
collects/profj/libs/java/lang/Object-composite.ss
View File

@ -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))))

6
collects/profj/libs/java/runtime.scm
View File

@ -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)))))))

17
collects/profj/to-scheme.ss
View File

@ -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)

7
collects/tests/profj/full-tests.ss
View File

@ -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); }