diff --git a/collects/profj/check.ss b/collects/profj/check.ss index fd8f6f5e1a..daaa507925 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -1457,7 +1457,7 @@ (expr-src exp) type-recs c-class - env level static?))) + env level static? interact?))) ((inner-alloc? exp) (set-expr-type exp (check-inner-alloc exp @@ -2315,8 +2315,8 @@ ;; 15.9 ;;check-class-alloc: expr (U name identifier) (list exp) (exp env -> type/env) src type-records - ; (list string) env symbol bool-> type/env - (define (check-class-alloc exp name/def arg-exps check-e src type-recs c-class env level static?) + ; (list string) env symbol bool bool-> type/env + (define (check-class-alloc exp name/def arg-exps check-e src type-recs c-class env level static? interact?) (let* ((args/env (check-args arg-exps check-e env)) (args (car args/env)) (name (cond @@ -2387,7 +2387,7 @@ (unless (lookup-exn thrown env type-recs level) (ctor-throws-error (ref-type-class/iface thrown) type src))) (method-record-throws const))) - (when (and (memq 'private mods) (not (eq? class-record this))) + (when (and (memq 'private mods) (or interact? (not (eq? class-record this)))) (class-access-error 'pri level type src)) (when (and (memq 'protected mods) (or (not (is-eq-subclass? this type type-recs)) (not (package-members? c-class (cons (ref-type-class/iface type) @@ -3346,7 +3346,7 @@ ((pro) (format "method ~a from ~a may only be called by ~a, a subclass, or package member of ~a" n t t t)) - ((pri) (format "~a does not contain a method named ~a" t n)) + ((pri) (format "~a does not contain a visible method named ~a" t n)) ((pac) (format "method ~a from ~a may only be called by ~a or a package member of ~a" n t t t)))) n src))) diff --git a/collects/profj/libs/java/runtime.scm b/collects/profj/libs/java/runtime.scm index f85f6c5cf6..c6a1131cda 100644 --- a/collects/profj/libs/java/runtime.scm +++ b/collects/profj/libs/java/runtime.scm @@ -187,7 +187,7 @@ (send val check-ref-type type dim))) ;nullError: symbol -> void - (define (nullError kind) + (define (nullError kind marks) (raise (create-java-exception NullPointerException (case kind @@ -197,7 +197,7 @@ "This value cannot retrieve a field as it is null and therefore has no fields")) (lambda (exn msg) (send exn NullPointerException-constructor-java.lang.String msg)) - (current-continuation-marks)))) + marks #;(current-continuation-marks)))) (define in-check-mutate? (make-parameter #f)) (define stored-checks (make-parameter null)) diff --git a/collects/profj/parsers/intermediate-access-parser.ss b/collects/profj/parsers/intermediate-access-parser.ss index 6b3c89bc1e..c014d34d71 100644 --- a/collects/profj/parsers/intermediate-access-parser.ss +++ b/collects/profj/parsers/intermediate-access-parser.ss @@ -225,7 +225,7 @@ (VariableDeclaratorId [(IDENTIFIER) (make-var-decl (make-id $1 (build-src 1)) - (list (make-modifier 'public #f)) + null (make-type-spec #f 0 (build-src 1)) #f (build-src 1))]) (VariableInitializer @@ -245,16 +245,17 @@ (build-src 2))]) (MethodHeader - [(Modifiers Type MethodDeclarator) (construct-method-header (cons (make-modifier 'public #f) $1) null $2 $3 null)] + [(Modifiers Type MethodDeclarator) + (construct-method-header $1 null $2 $3 null)] [(Modifiers void MethodDeclarator) - (construct-method-header (cons (make-modifier 'public #f) $1) + (construct-method-header $1 null (make-type-spec 'void 0 (build-src 2 2)) $3 null)] - [(Type MethodDeclarator) (construct-method-header (list (make-modifier 'public #f)) null $1 $2 null)] + [(Type MethodDeclarator) (construct-method-header null null $1 $2 null)] [(void MethodDeclarator) - (construct-method-header (list (make-modifier 'public #f)) + (construct-method-header null null (make-type-spec 'void 0 (build-src 1 1)) $2 @@ -280,9 +281,13 @@ (ConstructorDeclaration [(ConstructorDeclarator ConstructorBody) - (make-method (list (make-modifier 'public #f)) + (make-method null (make-type-spec 'ctor 0 (build-src 2)) null (car $1) - (cadr $1) null $2 #f #f (build-src 2))]) + (cadr $1) null $2 #f #f (build-src 2))] + [(Modifiers ConstructorDeclarator ConstructorBody) + (make-method $1 + (make-type-spec 'ctor 0 (build-src 3)) null (car $2) + (cadr $2) null $3 #f #f (build-src 3))]) (ConstructorDeclarator [(IDENTIFIER O_PAREN FormalParameterList C_PAREN) (list (make-id $1 (build-src 1)) (reverse $3))] diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index 53fdbd783b..483ab534d5 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -2483,7 +2483,8 @@ (make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src)) (make-syntax #f `(if (null? ,expr) - (javaRuntime:nullError 'field) + ,(create-syntax #f '(javaRuntime:nullError 'field (current-continuation-marks)) + expr) (send ,expr ,(translate-id field-string field-src))) (build-src src)))) ((and (eq? (var-access-access access) 'private) #;(or (static-method) (inner-class))) @@ -2492,7 +2493,10 @@ (get-syntax (if cant-be-null? (make-syntax #f getter (build-src src)) (make-syntax #f `(if (null? ,expr) - (javaRuntime:nullError 'field) + ,(create-syntax + #f + '(javaRuntime:nullError 'field (current-continuation-marks)) + expr) ,getter) (build-src src))))) (if (dynamic-val? type) @@ -2519,7 +2523,8 @@ (make-syntax #f `(let ([val~1 ,expr]) (if (null? val~1) - (javaRuntime:nullError 'field) + ,(create-syntax #f '(javaRuntime:nullError 'field (current-continuation-marks)) + expr) (,id val~1))) (build-src src))))) (if (dynamic-val? type) @@ -2585,7 +2590,8 @@ (else `(let ((,unique-name ,expression)) (if (null? ,unique-name) - (javaRuntime:nullError 'method) + ,(create-syntax #f '(javaRuntime:nullError 'method (current-continuation-marks)) + expression) (send-generic ,unique-name ,generic-c-name ,@args))))) (build-src src)) @@ -2594,7 +2600,8 @@ (create-syntax #f `(let ((,unique-name ,expression)) (if (null? ,unique-name) - ,(create-syntax #f `(javaRuntime:nullError 'method) expression) + ,(create-syntax #f `(javaRuntime:nullError 'method (current-continuation-marks)) + expression) (send ,unique-name ,c-name ,@translated-args))) (build-src src))))) @@ -2668,7 +2675,9 @@ (create-syntax #f `(let ((,unique-name ,expression)) (if (null? ,unique-name) - (javaRuntime:nullError 'method) + (javaRuntime:nullError 'method + ,(create-syntax #f + '(current-continuation-marks) expression)) (send ,unique-name ,name ,@translated-args))) (build-src src)))))) (if (or (method-contract? method-record)