From 165779f4b12716849c88b492ef54879378166120 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Thu, 16 Mar 2006 19:55:51 +0000 Subject: [PATCH] Corrected cast to String bug, punctuation and spelling errors in some error messages svn: r2445 --- collects/profj/build-info.ss | 86 +++++++++++++------------- collects/profj/check.ss | 70 ++++++++++----------- collects/profj/to-scheme.ss | 15 +++-- collects/tests/profj/advanced-tests.ss | 6 ++ 4 files changed, 94 insertions(+), 83 deletions(-) diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index 44b5aa5411..e0c9bb4b1b 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -1513,22 +1513,22 @@ ((dups) (format "Modifier ~a may only appear once in a declaration, it occurs multiple times here." m)) ((access) - "Declaration may only be one of public, private, or protected, more than one occurs here") + "Declaration may only be one of public, private, or protected, more than one occurs here.") ((invalid-iface) - (format "Modifier ~a is not valid for interfaces" m)) + (format "Modifier ~a is not valid for interfaces." m)) ((invalid-class) - (format "Modifier ~a is not valid for classes" m)) + (format "Modifier ~a is not valid for classes." m)) ((invalid-field) - (format "Modifier ~a is not valid for fields" m)) + (format "Modifier ~a is not valid for fields." m)) ((invalid-method) - (format "Modifier ~a is not valid for methods" m)) + (format "Modifier ~a is not valid for methods." m)) ((invalid-ctor) - (format "Modifier ~a is not valid for constructors" m)) + (format "Modifier ~a is not valid for constructors." m)) ((invalid-abstract) - (format "Modifier ~a is not valid for an abstract method" m)) - ((final-abstract) "Class declared final and abstract which is not allowed") - ((final-volatile) "Field declared final and volatile which is not allowed") - ((native-strictfp) "Method declared native and strictfp which is not allowed")) + (format "Modifier ~a is not valid for an abstract method." m)) + ((final-abstract) "Class declared final and abstract which is not allowed.") + ((final-volatile) "Field declared final and volatile which is not allowed.") + ((native-strictfp) "Method declared native and strictfp which is not allowed.")) m src))) ;dependence-error: symbol id src -> void @@ -1536,9 +1536,9 @@ (let ((n (id->ext-name name))) (raise-error n (case kind - ((immediate) (format "~a may not extend itself, which it does here" n)) + ((immediate) (format "~a may not extend itself, which it does here." n)) ((cycle) - (format "~a is illegally dependent on itself, potentially through other definitions" n))) + (format "~a is illegally dependent on itself, potentially through other definitions." n))) n src))) ;extension-error: symbol id name src -> void @@ -1549,26 +1549,26 @@ s (case kind ((final) - (format "Final classes may never be extended, therefore final class ~a may not be extended by ~a" s n)) + (format "Final classes may never be extended, therefore final class ~a may not be extended by ~a." s n)) ((implement) (format - "A class may only declare an implemented interface once, this class declares it is implementing ~a more than once" + "A class may only declare an implemented interface once, this class declares it is implementing ~a more than once." s)) ((ifaces) - (format "An interface may only declare each extended interface once, ~a declares this interface more than once" s)) + (format "An interface may only declare each extended interface once, ~a declares this interface more than once." s)) ((iface-class) - (format "Interfaces may never extend classes, interface ~a has attemped to extend ~a, which is a class" n s)) + (format "Interfaces may never extend classes, interface ~a has attemped to extend ~a, which is a class." n s)) ((class-iface) - (format "Classes may never extend interfaces, class ~a has attempted to extend ~a, which is an interface" n s)) + (format "Classes may never extend interfaces, class ~a has attempted to extend ~a, which is an interface." n s)) ((implement-class) - (format "Only interfaces may be implemented, class ~a has attempted to implement class ~a" n s))) + (format "Only interfaces may be implemented, class ~a has attempted to implement class ~a." n s))) s src))) ;method-error: symbol id (list type) type string src bool -> void (define (method-error kind name parms ret class src ctor?) (if (eq? kind 'inherited-conflict-field) (let ((n (id->ext-name name))) - (raise-error n (format "Field ~a conflicts with a method of the same name from ~a" n class) n src)) + (raise-error n (format "Field ~a conflicts with a method of the same name from ~a." n class) n src)) (let ((m-name (method-name->ext-name (id-string name) null)) (m-full-name (method-name->ext-name (id-string name) parms)) (r-name (type->ext-name ret))) @@ -1577,13 +1577,13 @@ (case kind ((illegal-abstract) (format - "Abstract method ~a is not allowed in non-abstract class ~a, abstract methods must be in abstract classes" + "Abstract method ~a is not allowed in non-abstract class ~a, abstract methods must be in abstract classes." m-full-name class)) ((repeated) - (format "~a ~a has already been written in this class, ~a, and cannot be written again" + (format "~a ~a has already been written in this class, ~a, and cannot be written again." (if ctor? "Constructor" "Method") m-full-name class)) ((inherit-conflict) - (format "Inherited method ~a from ~a conflicts with another method of the same name" m-full-name class)) + (format "Inherited method ~a from ~a conflicts with another method of the same name." m-full-name class)) ((conflict) (format "Method ~a conflicts with a method inherited from ~a" m-full-name class)) ((not-implement) (format "Method ~a returning ~a from ~a should be implemented and was not." m-full-name r-name class)) @@ -1614,7 +1614,7 @@ (cond ((= nt-l 0) "Given a method with no arguments.") ((= nt-l 1) (format "Given a method with one argument with type ~a." (car nt))) - (else (format "Given a method with ~a arguments with types ~a" nt-l nt)))) + (else (format "Given a method with ~a arguments with types ~a." nt-l nt)))) (string->symbol curr-class) src))) ;not-ctor-error: string string src -> void @@ -1623,17 +1623,17 @@ (raise-error n (format "~a~n~a" - (format "Method ~a has no return type and does not have the same name as the class, ~a" + (format "Method ~a has no return type and does not have the same name as the class, ~a." n class) - "Only constructors may have no return type, but must have the name of the class") + "Only constructors may have no return type, but must have the name of the class.") n src))) ;beginner-ctor-error: symbol id src -> void (define (beginner-ctor-error kind class src) (let ((n (id->ext-name class))) (raise-error n (case kind - ((none) (format "Class ~a must have a constructor" n)) - ((abstract) (format "Abstract class ~a may not have a constructor" n))) n src))) + ((none) (format "Class ~a must have a constructor." n)) + ((abstract) (format "Abstract class ~a may not have a constructor." n))) n src))) ;default-ctor-error symbol id string src symbol -> void (define (default-ctor-error kind name parent src level) @@ -1642,14 +1642,14 @@ (case kind ((private) (if (memq level '(beginner intermediate)) - (format "Class ~a cannot extend ~a" n parent) - (format "Class ~a cannot access the default constructor of ~a, which is private" n parent))) + (format "Class ~a cannot extend ~a." n parent) + (format "Class ~a cannot access the default constructor of ~a, which is private." n parent))) ((non-accessible) (if (memq level '(beginner intermediate)) - (format "Class ~a must have a constructor due to its extension of class ~a" n parent) - (format "Class ~a cannot access a default constructor for ~a" n parent))) + (format "Class ~a must have a constructor due to its extension of class ~a." n parent) + (format "Class ~a cannot access a default constructor for ~a." n parent))) ((throws) - (format "Class ~a cannot use the default constructor for ~a, as ~a's default contains a throws clause" + (format "Class ~a cannot use the default constructor for ~a, as ~a's default contains a throws clause." n parent parent))) n src))) @@ -1660,14 +1660,14 @@ (case kind ((num) (format - "Method ~a in ~a overrides a method from ~a: Method in ~a should throw no types if original doesn't" + "Method ~a in ~a overrides a method from ~a: Method in ~a should throw no types if original doesn't." (method-name->ext-name m-name parms) (car class) parent (car class))) ((subclass) - (let ((line1 (format "Method ~a in ~a overrides from a method from ~a" + (let ((line1 (format "Method ~a in ~a overrides from a method from ~a." (method-name->ext-name m-name parms) (car class) parent)) (line2 (format - "All types thrown by overriding method in ~a must be subtypes of original throws: ~a is not" + "All types thrown by overriding method in ~a must be subtypes of original throws: ~a is not." (car class) (type->ext-name throw)))) (format "~a~n~a" line1 line2)))) 'throws src)) @@ -1718,7 +1718,7 @@ (let ((name (id->ext-name (field-name parm)))) (raise-error name (format - "Method parameters may not share names, ~a in ~a cannot have multiple parameters with the name ~a" + "Method parameters may not share names, ~a in ~a cannot have multiple parameters with the name ~a." meth (car class) name) name (id-src (field-name parm))))) @@ -1729,21 +1729,21 @@ (case kind ((field) (format - "Each field in a class must have a unique name. Multiple fields have been declared with the name ~a" + "Each field in a class must have a unique name. Multiple fields have been declared with the name ~a." n)) ((method) - (format "~a has been declared as a field and a method, which is not allowed" n)) + (format "~a has been declared as a field and a method, which is not allowed." n)) ((class) - (format "~a has been declared as a field and a ~a, which is not allowed" n + (format "~a has been declared as a field and a ~a, which is not allowed." n (if (eq? level 'intermediate) "class or interface" "class"))) ((inherited-conflict-method) - (format "Method ~a conflicts with an inherited field of the same name" n))) + (format "Method ~a conflicts with an inherited field of the same name." n))) n src))) ;import-error: name src -> void (define (import-error imp src) (raise-error 'import - (format "Import ~a not found" (path->ext (name->path imp))) + (format "Import ~a not found." (path->ext (name->path imp))) 'import src)) ;file-error: symbol (list string) src symbol -> void @@ -1766,14 +1766,14 @@ ;used-restricted-import: string (list string) src -> void (define (used-restricted-import class path src) (raise-error 'import - (format "Imported class, ~a, cannot be imported or used" (path->ext (cons class path))) + (format "Imported class, ~a, cannot be imported or used." (path->ext (cons class path))) 'import src)) ;throws-error id src -> void (define (throws-error t src) (raise-error 'throws - (format "Thrown class must be a subtype of Throwable: Given ~a" (id->ext-name t)) + (format "Thrown class must be a subtype of Throwable: Given ~a." (id->ext-name t)) 'throws src)) (define build-info-location (make-parameter #f)) diff --git a/collects/profj/check.ss b/collects/profj/check.ss index 0b26e8a394..80fdfb375f 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -722,7 +722,7 @@ (define (inherited-field-not-set-error name src) (raise-error (string->symbol name) - (format "Inherited field ~a must be set in the constructor for the current class" name) + (format "Inherited field ~a must be set in the constructor for the current class." name) (string->symbol name) src)) ;raise-forward-reference: id src -> void @@ -872,15 +872,15 @@ (define (method-error kind method src) (raise-error method (case kind - ((no-reachable) (format "method ~a does not have a reachable return" method)) + ((no-reachable) (format "Method ~a does not have a reachable return." method)) ((abstract) (let ((line1 - (format "abstract method ~a has an implementation, abstract methods may not have implementations" + (format "Abstract method ~a has an implementation, abstract methods may not have implementations." method)) - (line2 "Either a ';'should come after the header, or the method should not be abstract")) + (line2 "Either a ';'should come after the header, or the method should not be abstract.")) (format "~a~n~a" line1 line2))) - ((native) (format "native method ~a has an implementation which is not allowed" method)) - ((no-body) (format "method ~a has no implementation and is not abstract" method))) + ((native) (format "Native method ~a has an implementation which is not allowed." method)) + ((no-body) (format "Method ~a has no implementation and is not abstract." method))) method src)) ;var-init-error: symbol symbol type type src -> void @@ -888,10 +888,10 @@ (raise-error name (case kind ((array) - (format "Expected ~a to be of declared type ~a, given an array" + (format "Expected ~a to be of declared type ~a, given an array." name (type->ext-name dec-type))) ((other) - (format "Expected ~a to be assignable to declared type ~a, given ~a which is unrelated" + (format "Expected ~a to be assignable to declared type ~a, given ~a which is unrelated." name (type->ext-name dec-type) (type->ext-name given)))) name src)) @@ -900,7 +900,7 @@ (let ((d (type->ext-name dec-type)) (g (type->ext-name given))) (raise-error g - (format "Error initializing declared array of ~a, given element with incompatible type ~a" + (format "Error initializing declared array of ~a, given element with incompatible type ~a." d g) d src))) @@ -908,7 +908,7 @@ (define (field-not-set-error name class kind src) (let ((n (id->ext-name name))) (raise-error n - (format "Field ~a from ~a must be set in the ~a and is not" + (format "Field ~a from ~a must be set in the ~a and is not." n class (case kind @@ -921,7 +921,7 @@ (define (beginner-ctor-error class kind src) (let ((exp (statement->ext-name kind))) (raise-error exp - (format "Constructor for ~a may only assign the fields of ~a. Found illegal statement ~a" + (format "Constructor for ~a may only assign the fields of ~a. Found illegal statement ~a." class class exp) exp src))) @@ -931,10 +931,10 @@ '= (case kind ((not-left-this) - "Constructor must assign the class's fields. This expression is not a field of this class and maynot be assigned") + "Constructor must assign the class's fields. This expression is not a field of this class and maynot be assigned.") ((right-this) - "The constructor maynot assign fields with other of its fields. Other values must be used")) - '= src)) + "The constructor maynot assign fields with other of its fields. Other values must be used.")) + '= src)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Statement checking functions @@ -1263,7 +1263,7 @@ ;make-condition-error: symbol type src -> void (define (kind-condition-error kind cond src) (raise-error kind - (format "~a condition must be a boolean: Given ~a" + (format "~a condition must be a boolean: Given ~a." kind (type->ext-name cond)) kind src)) @@ -1273,9 +1273,9 @@ (raise-error 'throw (case kind ((not-throwable) - (format "Expression for throw must be a subtype of Throwable: given ~a" t)) + (format "Expression for throw must be a subtype of Throwable: given ~a." t)) ((not-declared) - (format "Thrown type ~a must be declared as thrown or caught" t))) + (format "Thrown type ~a must be declared as thrown or caught." t))) 'throw src))) ;return-error: symbol type type src -> void @@ -1289,11 +1289,11 @@ (let ((line1 (format "The return expression's type must be equal to or a subclass of the method's return ~a." e)) (line2 - (format "The given expression has type ~a which is not equivalent to the declared return" g))) + (format "The given expression has type ~a which is not equivalent to the declared return." g))) (format "~a~n~a" line1 line2))) - ((void) "No value should be returned from void method, found a returned value") + ((void) "No value should be returned from void method, found a returned value.") ((val) - (format "Expected a return value assignable to ~a. No value was given" e))) + (format "Expected a return value assignable to ~a. No value was given." e))) 'return src))) ;illegal-redefinition: id src -> void @@ -1316,7 +1316,7 @@ ;catch-error: type src -> void (define (catch-error given src) (raise-error 'catch - (format "catch clause must catch an argument of subclass Throwable: Given ~a" + (format "Catch clause must catch an argument of subclass Throwable: Given ~a" (type->ext-name given)) 'catch src)) @@ -1336,23 +1336,23 @@ ;illegal-label: symbol string src -> void (define (illegal-label kind label src) (raise-error kind - (format "~a references label ~a, no enclosing statement has this label" + (format "~a references label ~a, no enclosing statement has this label." kind label) kind src)) ;break-error: src -> void (define (break-error src level) (raise-error 'break (if (eq? level 'full) - "break must be in either a loop or a switch" - "break must be in a loop") + "'break' must be in either a loop or a switch." + "'break' must be in a loop.") 'break src)) (define (continue-error src) - (raise-error 'continue "continue must be in a loop" 'continue src)) + (raise-error 'continue "'continue' must be in a loop." 'continue src)) ;synch-error: type src -> void (define (synch-error given src) (raise-error 'synchronize - (format "synchronization expression must be a subtype of Object: Given ~a" + (format "Synchronization expression must be a subtype of Object: Given ~a" (type->ext-name given)) 'synchronize src)) @@ -2663,9 +2663,9 @@ (raise-error op (case side - ((right) (format "Right hand side of ~a should be of type ~a, but given ~a" op ext-out rt)) - ((left) (format "Left hand side of ~a should be of type ~a, but given ~a" op ext-out lt)) - (else (format "~a expects arguments of type ~a, but given ~a and ~a" op ext-out lt rt))) + ((right) (format "Right hand side of ~a should be of type ~a, but given ~a." op ext-out rt)) + ((left) (format "Left hand side of ~a should be of type ~a, but given ~a." op ext-out lt)) + (else (format "~a expects arguments of type ~a, but given ~a and ~a." op ext-out lt rt))) op src))) ;bin-op-beginner-error symbol type type src -> void @@ -2725,11 +2725,11 @@ (raise-error name (case kind - ((not-found) (format "reference to undefined identifier ~a" name)) - ((class-name) (format "class named ~a cannot be used as a variable, which is how it is used here" name)) + ((not-found) (format "Reference to undefined identifier ~a." name)) + ((class-name) (format "Class named ~a cannot be used as a variable, which is how it is used here." name)) ((method-name) (let ((line1 - (format "method named ~a cannot be used as a variable, which is how it is used here." name)) + (format "Method named ~a cannot be used as a variable, which is how it is used here." name)) (line2 "A call to a method should be followed by () and any arguments to the method")) (format "~a~n~a" line1 line2)))) name src))) @@ -2779,17 +2779,17 @@ name (case level ((beginner intermediate) - (format "Field ~a cannot be retrieved from a class, ~a can only be accessed from an instance of the class" + (format "Field ~a cannot be retrieved from a class, ~a can only be accessed from an instance of the class." name name)) ((advanced full) - (format "Field ~a accessed as though static; this field is not a static field" name))) + (format "Field ~a accessed as though static; ~a is not a static field" name name))) name src)) ;beginner-field-access-error: symbol src -> void (define (beginner-field-access-error name src) (raise-error name - (format "field ~a from the current class accessed as a variable. fields should be accessed with 'this'" name) + (format "Field ~a from the current class accessed as a variable. Fields should be accessed with 'this'." name) name src)) ;illegal-field-access: symbol symbol symbol string src -> void diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index 0c48f7b9ec..21849c2221 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -2360,7 +2360,7 @@ (create-syntax #f `(let ((,unique-name ,expression)) (if (null? ,unique-name) - (javaRuntime:nullError 'method) + ,(create-syntax #f `(javaRuntime:nullError 'method) expression) (send ,unique-name ,c-name ,@translated-args))) (build-src src))))) @@ -2621,10 +2621,15 @@ (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)))))) + (if (or (eq? (syntax-object->datum class) 'String) + (eq? (syntax-object->datum class) 'java.lang.String)) + (make-syntax #f `(javaRuntime:cast-reference ,expr ,class null null ,(type-spec-dim type) + (quote ,(get-class-name type))) + (build-src src)) + (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) diff --git a/collects/tests/profj/advanced-tests.ss b/collects/tests/profj/advanced-tests.ss index f59aa79fa7..6601a0d9b6 100644 --- a/collects/tests/profj/advanced-tests.ss +++ b/collects/tests/profj/advanced-tests.ss @@ -319,6 +319,12 @@ class WeeklyPlanner{ (list '(void) '(void) '(void) '(void) 0 #f #\null null) "Array initialization checks") + (interact-test + 'advanced + (list "Object o = \"\";" "(String) o") + (list '(void) 'o~f) + "Casting to a String") + (report-test-results) ) \ No newline at end of file