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

Corrected bug of conflicting names between import and current file

Browse Source 
svn: r3985
This commit is contained in:
Kathy Gray 2006-08-08 17:58:37 +00:00
parent 9f07de9739
commit a361348bdc
4 changed files with 96 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/profj/build-info.ss
View File

@ -134,8 +134,10 @@
(add-my-package type-recs pname (package-defs prog) current-loc level))
;Add import information
(for-each (lambda (imp) (process-import type-recs imp level)) (package-imports prog))
(let ([cur-def-names (map def-name defs)])
(for-each (lambda (imp) (process-import type-recs imp cur-def-names level))
(package-imports prog)))
;Build jinfo information for each def in this file
(for-each (lambda (def) (process-class/iface def pname type-recs (null? args) #t level)) defs)
@ -201,25 +203,43 @@
;-----------------------------------------------------------------------------------
;Import processing/General loading
;;process-import: type-records import symbol -> void
(define (process-import type-recs imp level)
;;process-import: type-records import (listof id) symbol -> void
(define (process-import type-recs imp def-names level)
(let* ((star? (import-star imp))
(file (import-file imp))
(name (id-string (name-id (import-name imp))))
(name-path (map id-string (name-path (import-name imp))))
(path (if star? (append name-path (list name)) name-path))
(string-path (map id-string (name-path (import-name imp))))
(path (if star? (append string-path (list name)) string-path))
(err (lambda () (import-error (import-name imp) (import-src imp)))))
(if star?
(let ((classes (send type-recs get-package-contents path (lambda () #f))))
(if classes
(for-each (lambda (class) (send type-recs add-to-env class path file)) classes)
(let* ((dir (find-directory path err))
(classes (get-class-list dir)))
(for-each (lambda (class)
(import-class class path dir file type-recs level (import-src imp) #t))
classes)
(send type-recs add-package-contents path classes))))
(import-class name path (find-directory path err) file type-recs level (import-src imp) #t))))
(cond
[star?
(let ([classes (send type-recs get-package-contents path (lambda () #f))]
[check-dup-import
(lambda (importer)
(lambda (class)
(let ([dup? (memf (lambda (e) (equal? class (id-string e))) def-names)])
(if dup?
(unless (eq? level 'full)
(import-dup-error 'star (id-string (car dup?)) (reverse path) (id-src (car dup?))))
(importer class)))))])
(cond
[classes
(for-each (check-dup-import
(lambda (class) (send type-recs add-to-env class path file))) classes)]
[else
(let* ([dir (find-directory path err)]
[class-list (get-class-list dir)]
[package-contents null])
(for-each (check-dup-import
(lambda (class)
(import-class class path dir file type-recs level (import-src imp) #t)
(set! package-contents (cons class package-contents))))
class-list)
(send type-recs add-package-contents path package-contents))]))]
[else
(when (member name (map id-string def-names))
(import-dup-error 'no-star name (reverse path) (import-src imp)))
(import-class name path (find-directory path err) file type-recs level (import-src imp) #t)])))
;import-class: string (list string) dir-path location type-records symbol src bool-> void
(define (import-class class path in-dir loc type-recs level caller-src add-to-env)
@ -506,7 +526,8 @@
(send type-recs set-location! (def-file class))
(let ((build-record
(lambda ()
(when put-in-table? (send type-recs add-to-records cname 'in-progress))
(when put-in-table?
(send type-recs add-to-records cname 'in-progress))
(let* ((super (if (null? (header-extends info)) null (car (header-extends info))))
(super-name (if (null? super)
'("Object" "java" "lang")
@ -1969,6 +1990,18 @@
(raise-error 'import
(format "Import ~a not found." (path->ext (name->path imp)))
'import src))
;import-dup-error: symbol string [list id] src -> void
(define (import-dup-error kind name path src)
(raise-error 'import
(case kind
[(star) (format "~a cannot be used to name a class or interface, as it conflicts with an import from ~a."
name (path->ext path))]
[(no-star)
(format "Class or interface ~a~a cannot be imported, as it conflicts with a class or interface in this file."
name (if (null? path) "" (format " from ~a" (path->ext path))))])
(string->symbol name)
src))
;file-error: symbol (list string) src symbol -> void
(define (file-error kind path src level)

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

@ -81,11 +81,11 @@
;divide-int: int int -> int
(define (divide-int left right)
(when (zero? right)
(create-java-exception ArithmeticException
"Illegal division by zero"
(lambda (exn msg)
(send exn ArithmeticException-constructor-java.lang.String msg))
(current-continuation-marks)))
(raise (create-java-exception ArithmeticException
"Illegal division by zero"
(lambda (exn msg)
(send exn ArithmeticException-constructor-java.lang.String msg))
(current-continuation-marks))))
(quotient left right))
;divide-float: float float -> float
@ -247,10 +247,9 @@
(fail? #f))
(set! test
(with-handlers ((exn?
(lambda (e) (if catch?
(begin (set! fail? #t)
(list exception e))
(raise e)))))
(lambda (e)
(set! fail? #t)
(list exception catch? e))))
(test)))
(let ([res (if fail? #f (java-equal? test act null null))]
[values-list (append (list act test) (if (null? within?) (list range) null))])
@ -313,10 +312,12 @@
(define (compose-message test-obj check-kind info values mutate-message)
(letrec ((test-format (construct-info-msg info))
(exception-raised? #f)
(exception-not-error? #f)
(formatted-values (map (lambda (v)
(if (and (pair? v) (eq? (car v) exception))
(begin (set! exception-raised? #t)
(send test-obj format-value (cadr v)))
(set! exception-not-error? (cadr v))
(send test-obj format-value (caddr v)))
(send test-obj format-value v))) values))
(expected-format
(case check-kind
@ -331,9 +332,13 @@
(append (if (= (length formatted-values) 3)
(list ", within " (third formatted-values))
null)
(if exception-raised?
(list ", instead a " (second formatted-values) " exception occurred")
(list ", instead found " (second formatted-values)))))
(cond
[(and exception-raised? (not exception-not-error?))
(list ", instead a " (second formatted-values) " exception occurred")]
[(and exception-raised? exception-not-error?)
(list", instead an error occured")]
[else
(list ", instead found " (second formatted-values))])))
((check-catch)
(if (= (length formatted-values) 1)
(list ", instead no exceptions occured")

10
collects/tests/profj/beginner-tests.ss
View File

@ -316,6 +316,16 @@
class B implements A { B () { } }"
language #t "Implementing a class")
(execute-test
"import java.util.Random;
class Random { }"
language #t "Renaming an imported class")
(execute-test
"import geometry.*;
class Posn { }"
language #t "Renaming an imported class with a star")
;;Interaction tests: Mix of pass and fail
(interact-test

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

@ -4,6 +4,20 @@
(prepare-for-tests "Full")
(execute-test
"import java.util.*;
class Random { }"
'full #f "Hiding an import * name with a local class"
)
(interact-test
"import java.util.*;
class Random {
int getInt() { return 3; }
}"
'full '("new Random().getInt()") '(3)
"Using the local Random and not the imported one")
(interact-test
"class allPublic {
public int x() { return 3; }
@ -92,7 +106,7 @@
(interact-test
"interface I { int m( int x); }
class C implements I {
int m(int x) { return x; }
public int m(int x) { return x; }
boolean n(boolean y) { return !y; }
dynamic q(I x) { return x; }
}" 'full
@ -246,12 +260,12 @@
(execute-test
"interface Bt { int largestNum(); }
class Leaf implements Bt { int largestNum() { return 1 ;} }
class Leaf implements Bt { public int largestNum() { return 1 ;} }
class Heap implements Bt {
Bt left;
Bt right;
int largestNum(){
public int largestNum(){
if(this.left instanceof Heap &&
this.right instanceof Heap)
return this.right.largestNum();