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

Corrected cast to String bug, punctuation and spelling errors in some error messages

Browse Source 
svn: r2445
This commit is contained in:
Kathy Gray 2006-03-16 19:55:51 +00:00
parent 56f6cc0211
commit 165779f4b1
4 changed files with 94 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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))

70
collects/profj/check.ss
View File

@ -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

15
collects/profj/to-scheme.ss
View File

@ -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)

6
collects/tests/profj/advanced-tests.ss
View File

@ -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)
)