Corrected bug in statements after loop, running same language in two
windows/tabs, substring off by one error, spelling error in error message svn: r2591
This commit is contained in:
Kathy Gray
parent
740a1bd826
commit
524dbb1cbe
|
|
@ -1108,7 +1108,7 @@
|
|||
(define (check-while cond/env src check-s loop-body)
|
||||
((check-cond 'while) (type/env-t cond/env) src)
|
||||
(check-s loop-body (type/env-e cond/env) #t #f)
|
||||
(make-type/env 'void (type/env-t cond/env)))
|
||||
(make-type/env 'void (type/env-e cond/env)))
|
||||
|
||||
;check-do: (exp env -> type/env) exp src type/env -> type/env
|
||||
(define (check-do check-e exp src loop/env)
|
||||
|
|
@ -2746,7 +2746,7 @@
|
|||
((method-name)
|
||||
(let ((line1
|
||||
(format "Method ~a is being erroneously accessed as a field for class ~a." field t))
|
||||
(line2 "A call to a method chould be followed by () and any arguments to the method"))
|
||||
(line2 "A call to a method should be followed by () and any arguments to the method"))
|
||||
(format "~a~n~a" line1 line2)))
|
||||
((array)
|
||||
(format "~a only has a length field, attempted to access ~a" t field))
|
||||
|
|
|
|||
|
|
@ -733,7 +733,7 @@
|
|||
(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))
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -465,56 +465,58 @@
|
|||
[class-path ((current-module-name-resolver) '(lib "class.ss") #f #f)]
|
||||
[mred-path ((current-module-name-resolver) '(lib "mred.ss" "mred") #f #f)]
|
||||
[n (current-namespace)])
|
||||
(read-case-sensitive #t)
|
||||
(run-in-user-thread
|
||||
(lambda ()
|
||||
(error-display-handler
|
||||
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
|
||||
(let ((old-current-eval (drscheme:debug:make-debug-eval-handler (current-eval))))
|
||||
(current-eval
|
||||
(lambda (exp)
|
||||
(syntax-case exp (parse-java-full-program parse-java-interactions)
|
||||
((parse-java-full-program ex)
|
||||
(let ((exp (old-current-eval (syntax ex))))
|
||||
(execution? #t)
|
||||
(let ((name-to-require #f))
|
||||
(let loop ((mods (order (compile-ast exp level execute-types)))
|
||||
(extras (process-extras
|
||||
(send execute-types get-interactions-boxes) execute-types))
|
||||
(require? #f))
|
||||
(cond
|
||||
((and (not require?) (null? mods) (null? extras)) (void))
|
||||
((and (not require?) (null? mods))
|
||||
(old-current-eval (syntax-as-top (car extras)))
|
||||
(loop mods (cdr extras) require?))
|
||||
(require?
|
||||
(old-current-eval
|
||||
(syntax-as-top (with-syntax ([name name-to-require])
|
||||
(syntax (require name)))))
|
||||
(loop mods extras #f))
|
||||
(else
|
||||
(let-values (((name syn) (get-module-name (expand (car mods)))))
|
||||
(set! name-to-require name)
|
||||
(syntax-as-top (old-current-eval syn))
|
||||
(loop (cdr mods) extras #t))))))))
|
||||
((parse-java-interactions ex loc)
|
||||
(let ((exp (syntax-object->datum (syntax ex))))
|
||||
(old-current-eval
|
||||
(syntax-as-top (compile-interactions-ast exp (syntax loc) level execute-types #t)))))
|
||||
(_ (old-current-eval exp))))))
|
||||
(with-handlers ([void (lambda (x) (printf "~a~n" (exn-message x)))])
|
||||
(namespace-require 'mzscheme)
|
||||
(namespace-attach-module n obj-path)
|
||||
(namespace-attach-module n string-path)
|
||||
(namespace-attach-module n class-path)
|
||||
(namespace-attach-module n mred-path)
|
||||
(namespace-require obj-path)
|
||||
(namespace-require string-path)
|
||||
(namespace-require class-path)
|
||||
(namespace-require mred-path)
|
||||
(namespace-require '(prefix javaRuntime: (lib "runtime.scm" "profj" "libs" "java")))
|
||||
(namespace-require '(prefix c: (lib "contract.ss")))
|
||||
)))))
|
||||
(let ((execute-types (create-type-record)))
|
||||
(read-case-sensitive #t)
|
||||
(run-in-user-thread
|
||||
(lambda ()
|
||||
(error-display-handler
|
||||
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
|
||||
(let ((old-current-eval (drscheme:debug:make-debug-eval-handler (current-eval))))
|
||||
(current-eval
|
||||
(lambda (exp)
|
||||
(syntax-case exp (parse-java-full-program parse-java-interactions)
|
||||
((parse-java-full-program ex)
|
||||
(let ((exp (old-current-eval (syntax ex))))
|
||||
(execution? #t)
|
||||
(set! execute-types (create-type-record))
|
||||
(let ((name-to-require #f))
|
||||
(let loop ((mods (order (compile-ast exp level execute-types)))
|
||||
(extras (process-extras
|
||||
(send execute-types get-interactions-boxes) execute-types))
|
||||
(require? #f))
|
||||
(cond
|
||||
((and (not require?) (null? mods) (null? extras)) (void))
|
||||
((and (not require?) (null? mods))
|
||||
(old-current-eval (syntax-as-top (car extras)))
|
||||
(loop mods (cdr extras) require?))
|
||||
(require?
|
||||
(old-current-eval
|
||||
(syntax-as-top (with-syntax ([name name-to-require])
|
||||
(syntax (require name)))))
|
||||
(loop mods extras #f))
|
||||
(else
|
||||
(let-values (((name syn) (get-module-name (expand (car mods)))))
|
||||
(set! name-to-require name)
|
||||
(syntax-as-top (old-current-eval syn))
|
||||
(loop (cdr mods) extras #t))))))))
|
||||
((parse-java-interactions ex loc)
|
||||
(let ((exp (syntax-object->datum (syntax ex))))
|
||||
(old-current-eval
|
||||
(syntax-as-top (compile-interactions-ast exp (syntax loc) level execute-types #t)))))
|
||||
(_ (old-current-eval exp))))))
|
||||
(with-handlers ([void (lambda (x) (printf "~a~n" (exn-message x)))])
|
||||
(namespace-require 'mzscheme)
|
||||
(namespace-attach-module n obj-path)
|
||||
(namespace-attach-module n string-path)
|
||||
(namespace-attach-module n class-path)
|
||||
(namespace-attach-module n mred-path)
|
||||
(namespace-require obj-path)
|
||||
(namespace-require string-path)
|
||||
(namespace-require class-path)
|
||||
(namespace-require mred-path)
|
||||
(namespace-require '(prefix javaRuntime: (lib "runtime.scm" "profj" "libs" "java")))
|
||||
(namespace-require '(prefix c: (lib "contract.ss")))
|
||||
))))))
|
||||
|
||||
#;(define/public (render-value value settings port); port-write)
|
||||
(let ((print-full? (profj-settings-print-full? settings))
|
||||
|
|
|
|||
|
|
@ -1,10 +1,26 @@
|
|||
(module advanced-tests mzscheme
|
||||
(require (lib "profj-testing.ss" "profj"))
|
||||
(require (lib "String.ss" "profj" "libs" "java" "lang"))
|
||||
|
||||
(prepare-for-tests "Advanced")
|
||||
|
||||
;;Execution tests without errors
|
||||
|
||||
(execute-test
|
||||
"class Blah {
|
||||
Blah () {}
|
||||
int addUp (int top) {
|
||||
int answer = 0;
|
||||
int counter = 1;
|
||||
while (counter <= top) {
|
||||
answer += counter;
|
||||
++counter;
|
||||
}
|
||||
return answer;
|
||||
}
|
||||
}"
|
||||
'advanced #f "while loop with statements after")
|
||||
|
||||
(execute-test
|
||||
"interface A { int a( int x); }
|
||||
abstract class B implements A { }
|
||||
|
|
@ -325,6 +341,13 @@ class WeeklyPlanner{
|
|||
(list '(void) 'o~f)
|
||||
"Casting to a String")
|
||||
|
||||
(interact-test
|
||||
'advanced
|
||||
(list "\"hello\".substring(2,5)")
|
||||
(list (make-java-string "llo"))
|
||||
"Test of substring")
|
||||
|
||||
|
||||
(report-test-results)
|
||||
|
||||
)
|
||||
Loading…
Reference in New Issue
Block a user