diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index cf40a7cb17..46eaf55953 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -854,6 +854,26 @@ ;valid-method-sigs? (list method-record) (list member) symbol type-records -> bool (define (valid-method-sigs? methods members level type-recs) (or (null? methods) + (and (equal? (method-record-name (car methods)) + (method-record-class (car methods))) + (not (eq? (method-record-rtype (car methods)) 'ctor)) + (let ((m (find-member (car methods) members level type-recs)) + (class (method-record-class (car methods)))) + (if (field? m) + (method-error 'inherited-conflict-field + (field-name m) + null + #f + (car class) + (field-src m) + #f) + (method-error 'ctor-ret-value + (method-name m) + (map field-type (method-parms m)) + (type-spec-to-type (method-type) #f level type-recs) + (car class) + (method-src m) + #f)))) (let ((res (same-method-name? (car methods) (cdr methods))) (m (and (not (eq? 'ctor (method-record-rtype (car methods)))) (find-member (car methods) members level type-recs))) @@ -886,26 +906,6 @@ (car class) (method-src m) (eq? (method-record-rtype (car methods)) 'ctor))))) - (and (equal? (method-record-name (car methods)) - (method-record-class (car methods))) - (not (eq? (method-record-rtype (car methods)) 'ctor)) - (let ((m (find-member (car methods) members level type-recs)) - (class (method-record-class (car methods)))) - (if (field? m) - (method-error 'inherited-conflict-field - (field-name m) - null - #f - (car class) - (field-src m) - #f) - (method-error 'ctor-ret-value - (method-name m) - (map field-type (method-parms m)) - (type-spec-to-type (method-type) #f level type-recs) - (car class) - (method-src m) - #f)))) (and (memq level `(beginner intermediate)) (not (eq? (method-record-rtype (car methods)) 'ctor)) (shared-class-name? (car methods) (send type-recs get-class-env)) diff --git a/collects/profj/libs/java/lang/Object-composite.ss b/collects/profj/libs/java/lang/Object-composite.ss index f35b80ec2a..387a8b1cbe 100644 --- a/collects/profj/libs/java/lang/Object-composite.ss +++ b/collects/profj/libs/java/lang/Object-composite.ss @@ -674,10 +674,27 @@ (define/public (lastIndexOf-java.lang.String-int str offset) (find-last-string (send str get-mzscheme-string) str offset -1)) ;int -> String - (define/public (substring-int index) (make-java-string (substring text index (string-length text)))) + (define/public (substring-int index) + (substring-int-int index (sub1 (string-length text)))) ;... -> String - (define/public (substring-int-int begin end) (make-java-string (substring text begin end))) + (define/public (substring-int-int begin end) + (when (< begin 0) + (raise (make-runtime-error + (format "First argument to substring must be greater than 0, given ~a." begin)))) + (when (>= begin (string-length text)) + (raise (make-runtime-error + (format "First argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) begin)))) + (when (>= end (string-length text)) + (raise (make-runtime-error + (format "Second argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) end)))) + (when (< end 0) + (raise (make-runtime-error + (format "Second argument to substring must be greater than 0, given ~a." end)))) + (when (> begin end) + (raise (make-runtime-error + (format "First argument to substring must be less than the second, given ~a and ~a." begin end)))) + (make-java-string (substring text begin end))) (define/public (subSequence-int-int begin end) (error 'subSequence "Internal Error: subsequence is unimplemented because charSequence is unimplemented")) @@ -825,7 +842,7 @@ (send this Object-constructor)) (define/public (Throwable-constructor-java.lang.Throwable cse) - (set! message (if (null? cse) null (send cse |toString|))) + (set! message (if (null? cse) null (send cse toString))) (set! cause cse) (set! stack (current-continuation-marks)) (send this Object-constructor)) @@ -905,6 +922,14 @@ (send exn set-exception! scheme-exn) scheme-exn)) + (define (make-runtime-error t) + (create-java-exception + RuntimeException (string->immutable-string t) + (lambda (exn str) + (send exn RuntimeException-constructor-java.lang.String + (make-java-string str))) + (current-continuation-marks))) + (provide convert-assert-Throwable wrap-convert-assert-Throwable dynamic-Throwable/c guard-convert-Throwable static-Throwable/c) diff --git a/collects/profj/parsers/beginner-parser.ss b/collects/profj/parsers/beginner-parser.ss index 77de8cc031..c02b405edc 100644 --- a/collects/profj/parsers/beginner-parser.ss +++ b/collects/profj/parsers/beginner-parser.ss @@ -254,15 +254,6 @@ ;; 19.9.1 (InterfaceDeclaration - [(interface IDENTIFIER ExtendsInterfaces InterfaceBody) - (make-interface-def (make-header (make-id $2 (build-src 2 2)) (list (make-modifier 'public #f)) - $3 null null (build-src 3)) - $4 - (build-src 1) - (build-src 4) - (file-path) - 'intermedaite - null 'top null)] [(interface IDENTIFIER InterfaceBody) (make-interface-def (make-header (make-id $2 (build-src 2 2))(list (make-modifier 'public #f)) null null null (build-src 2)) @@ -270,13 +261,9 @@ (build-src 1) (build-src 3) (file-path) - 'intermdediate + 'beginner null 'top null)]) - (ExtendsInterfaces - [(extends InterfaceType) (list $2)] - [(ExtendsInterfaces COMMA InterfaceType) (cons $3 $1)]) - (InterfaceBody [(O_BRACE InterfaceMemberDeclarations C_BRACE) $2]) diff --git a/collects/profj/parsers/parse-error.ss b/collects/profj/parsers/parse-error.ss index 54f79cee47..9fa1f335cf 100644 --- a/collects/profj/parsers/parse-error.ss +++ b/collects/profj/parsers/parse-error.ss @@ -434,11 +434,18 @@ (next-tok (get-tok next))) (cond ((eof? next-tok) (parse-error (format "Expected interface body after ~a" (token-value tok)) srt end)) - ((extends? next-tok) (parse-definition next (getter) 'iface-extends getter)) + ((extends? next-tok) + (if (beginner?) + (parse-error "Expected '{' to begin interface body, found 'extends' which is not allowed here" + (get-start next) (get-end next)) + (parse-definition next (getter) 'iface-extends getter))) ((o-brace? next-tok) (parse-definition cur-tok next 'iface-body getter)) ((close-to-keyword? next-tok 'extends) - (parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok)) - (get-start next) (get-end next))) + (if (beginner?) + (parse-error (format "Expected '{' to begin interface body, ~a cannot appear here" (token-value next-tok)) + (get-start next) (get-end next)) + (parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok)) + (get-start next) (get-end next)))) ((open-separator? next-tok) (parse-error (format "Expected { to begin interface body, but found ~a" (format-out next-tok)) (get-start next) (get-end next))) @@ -1363,10 +1370,14 @@ cur-tok (parse-error "A name may not contain a *" start stop))) (else - (if (java-keyword? tok) - (parse-error (format "Expected variable after ., found reserved word ~a, which may not be a variable" kind) - start stop) - (parse-error (format "Expected variable after . in name, found ~a" (format-out tok)) start stop)))))) + (cond + ((eq? 'this kind) + (parse-error "'this' cannot occur after a '.', only before" start stop)) + ((java-keyword? tok) + (parse-error (format "Expected name after '.', found reserved word ~a, which may not appear here" kind) + start stop)) + (else + (parse-error (format "Expected name after '.', found ~a" (format-out tok)) start stop))))))) ;parse-ctor-body: token token (->token) -> token (define (parse-ctor-body pre cur-tok getter) @@ -2064,7 +2075,7 @@ 'statement-expr-snd getter ctor? super-seen?)))) (else (parse-error (format "Expected a ')' or a ','. Found ~a which is not allowed" out) start end)))) ))) - + ;parse-expression: token token state (->token) bool bool -> token (define (parse-expression pre cur-tok state getter statement-ok? stmt-exp?) ;(printf "parse-expression state ~a pre ~a cur-tok ~a statement-ok? ~a stmt-exp? ~a ~n" @@ -2158,9 +2169,11 @@ (parse-expression next (parse-expression afterID (getter) 'start getter #f #f) 'assign-end getter statement-ok? stmt-exp?)) (else (parse-expression next afterID 'dot-op-or-end getter statement-ok? stmt-exp?))))) - ((java-keyword? next-tok) - (parse-error (format "Expected a method name, reserved name ~a may not be a method name" name) ns ne)) - (else (parse-error (format "Expected a method name, found ~a" (format-out next-tok)) ns ne))))) + ((eq? 'this name) + (parse-error "Expected a name, 'this' may not appear after a dot" ns ne)) + ((java-keyword? next-tok) + (parse-error (format "Expected a name, reserved name ~a may not be a name" name) ns ne)) + (else (parse-error (format "Expected a name, found ~a" (format-out next-tok)) ns ne))))) (stmt-exp? (parse-expression pre cur-tok 'op-or-end getter #f stmt-exp?)) ((bin-operator? tok) (parse-expression cur-tok (getter) 'start getter #f stmt-exp?)) ;Advanced