diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index 0a094d27a0..0897a321ff 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -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) diff --git a/collects/profj/libs/java/runtime.scm b/collects/profj/libs/java/runtime.scm index c4d906aa03..7a028ed76e 100644 --- a/collects/profj/libs/java/runtime.scm +++ b/collects/profj/libs/java/runtime.scm @@ -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") diff --git a/collects/tests/profj/beginner-tests.ss b/collects/tests/profj/beginner-tests.ss index 00ae773901..a8968ec44f 100644 --- a/collects/tests/profj/beginner-tests.ss +++ b/collects/tests/profj/beginner-tests.ss @@ -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 diff --git a/collects/tests/profj/full-tests.ss b/collects/tests/profj/full-tests.ss index 018cf0f302..b74a21da06 100644 --- a/collects/tests/profj/full-tests.ss +++ b/collects/tests/profj/full-tests.ss @@ -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();