Fixes to v4 errors discovered in test suite;

Fixes to undefined errors in parser;
Tweak to error selection in parser;
Removal of irrelevant preference in ProfJ Tool

svn: r9536
This commit is contained in:
Kathy Gray 2008-04-29 16:07:47 +00:00
parent c71192136e
commit 6a1b99a74f
6 changed files with 41 additions and 38 deletions

View File

@ -447,18 +447,18 @@
(cond
[(and (repeat-res? look-back)
(fail-type? (repeat-res-stop look-back))
(> (fail-type-chance (repeat-res-stop look-back))
(fail-type-chance fail)))
(>= (fail-type-chance (repeat-res-stop look-back))
(fail-type-chance fail)))
(repeat-res-stop look-back)]
[(and (choice-res? look-back)
(choice-res-errors look-back)
(> (fail-type-chance (choice-res-errors look-back))
(fail-type-chance fail)))
(>= (fail-type-chance (choice-res-errors look-back))
(fail-type-chance fail)))
(choice-res-errors look-back)]
[(and (res? look-back)
(fail-type? (res-possible-error look-back))
(> (fail-type-chance (res-possible-error look-back))
(fail-type-chance fail)))
(>= (fail-type-chance (res-possible-error look-back))
(fail-type-chance fail)))
(res-possible-error look-back)]
[else #f])]
[(next-ok?)
@ -505,7 +505,7 @@
(fail-type-name (res-msg old-res))
(and (fail-type? (res-possible-error look-back)) (fail-type-chance (res-possible-error look-back)))
(fail-type-chance (res-msg old-res)))
#;(printf "lookback ~a~n" (res-possible-error look-back)))
(printf "lookback ~a~n" (res-possible-error look-back)))
(let* ([seq-fail-maker
(lambda (fail used)
(let-values ([(kind expected found) (get-fail-info fail)])
@ -532,7 +532,7 @@
#;(when pos-fail
(printf "used ~a look-back-ref used ~a ~n"
used (when (res? look-back-ref) (res-used look-back-ref)))
#;(printf "opt-fails ~a~n" opt-fails))
(printf "opt-fails ~a~n" opt-fails))
(if pos-fail
(make-options-fail (rank-choice (map fail-type-chance opt-fails))
#f
@ -700,7 +700,7 @@
[choice-names (lambda () (map (lambda (o) (o return-name)) opt-list))])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
#;(unless (eq? input return-name) (printf "choice ~a~n" name))
#;(printf "possible options are ~a~n" choice-names)
#;(printf "possible options are ~a~n" (choice-names))
(let ([sub-opts (sub1 (+ alts num-choices))])
(cond
[(weak-map-get memo-table input #f) (weak-map-get memo-table input)]

View File

@ -126,12 +126,15 @@
(collapse-message
(add-to-message (car messages) name #f message-to-date))]
[else
(collapse-message
(add-to-message
(msg (format "An error occured in the ~a. Possible errors were: ~n ~a"
name
(alternate-error-list (map err-msg messages))))
name #f message-to-date))]))]
(let ([msg (cond
[(apply equal? (map err-src messages)) (lambda (m) (make-err m (err-src (car messages))))]
[else msg])])
(collapse-message
(add-to-message
(msg (format "An error occured in the ~a. Possible errors were: ~n ~a"
name
(alternate-error-list (map err-msg messages))))
name #f message-to-date)))]))]
[else
(fail-type->message
(car winners)
@ -223,16 +226,16 @@
(narrow-opts chance-may-use chance-used-winners)]
[winners (narrow-opts chance chance-may-winners)])
#;(printf "all options: ~a~n" (!!list opts-list))
#;(printf "all options: ~a~n" opts-list)
#;(printf "~a ~a ~a ~a ~n"
(map fail-type-name (map !!! (!!list opts-list)))
(map !!! (map fail-type-chance (!!list opts-list)))
(map !!! (map fail-type-used (!!list opts-list)))
(map !!! (map fail-type-may-use (!!list opts-list))))
(map fail-type-name opts-list)
(map fail-type-chance opts-list)
(map fail-type-used opts-list)
(map fail-type-may-use opts-list))
#;(printf "composite round: ~a ~a ~n"
(map fail-type-name (map !!! composite-winners))
(map composite (map !!! composite-winners)))
#;(printf "final sorting: ~a~n" (map fail-type-name (map !!! winners)))
(map fail-type-name composite-winners)
(map composite composite-winners))
#;(printf "final sorting: ~a~n" (map fail-type-name winners))
winners))
(define (first-n n lst)

View File

@ -334,7 +334,7 @@
"class instantiation"))
(define (new-array type-name)
(sequence (new type-name O_BRACKET expression C_BRACKET (repeat (sequence (O_BRACKET expression C_BRACKET) id)))
(sequence (new type-name O_BRACKET (eta expression) C_BRACKET (repeat (sequence (O_BRACKET (eta expression) C_BRACKET) id)))
id "array instantiation"))
(define field-access-end
@ -346,7 +346,7 @@
(define (array-init-maker contents)
(sequence (O_BRACE (comma-sep contents "array elements") C_BRACE) id "array initializations"))
(define array-init
(define array-init
(letrec ([base-init (array-init-maker (eta expression))]
[simple-init (array-init-maker
(choose ((eta expression) base-init (eta init)) "array initializations"))]
@ -362,13 +362,13 @@
(define simple-method-call
(choose
((sequence ((^ identifier) O_PAREN C_PAREN) id)
(sequence ((^ identifier) O_PAREN (comma-sep (eta expression) "arguments sm") C_PAREN) id))
(sequence ((^ identifier) O_PAREN (comma-sep (eta expression) "arguments") C_PAREN) id))
"method invocation"))
(define method-call-end
(choose
((sequence (PERIOD (^ identifier) O_PAREN C_PAREN) id)
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep (eta expression) "arguments me") C_PAREN) id))
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep (eta expression) "arguments") C_PAREN) id))
"method invocation"))
(define (assignment asignee op)
@ -937,7 +937,7 @@
(define (statement-c interact?)
(if interact?
(choose ((return-s #t)
(if-s statement #t)
(if-s (eta statement) #t)
(block #t)
(for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t #f "for loop variable")
(comma-sep stmt-expr "initializations")) "for loop initialization")
@ -955,7 +955,7 @@
assignment-ops)
) "statement")
(choose ((return-s #t)
(if-s statement #t)
(if-s (eta statement) #t)
(variable-declaration (array-type (value+name-type prim-type))
(choose (expression array-init) "variable initialization") #t #t "local variable")
(block #t)

View File

@ -377,7 +377,7 @@
(lambda (def) (send type-recs set-composite-location (id-string (def-name def)) location))
defs)
`(file ,(path->string (build-path (string-append (symbol->string (module-name)) ".ss")))))
(module-name)))
#`(quote #,(module-name))))
(let* ((translated-defs
(map (lambda (d)
(cond
@ -1459,7 +1459,7 @@
null)
(generate-contract-defs (class-name)))
)
(make-syntax #f `(module ,name mzscheme (require ,(module-name)) ,provides) #f)))))
(make-syntax #f `(module ,name mzscheme (require ,(module-require)) ,provides) #f)))))
;-----------------------------------------------------------------------------------------------------------------
;Member translation functions

View File

@ -400,7 +400,7 @@
[allow-test (when (eq? level 'full)
(make-object check-box% (string-constant profj-language-config-support-test-language)
testing-prefs (lambda (x y) update-at2)))]
[display-testing
#;[display-testing
(make-object check-box% (string-constant profj-language-config-testing-enable)
testing-prefs (lambda (x y) (update-dt x y)))]
[collect-coverage
@ -565,8 +565,8 @@
(send allow-testing get-value))
(and (eq? level 'full)
(send allow-test get-value))
(send display-testing get-value)
(and (send display-testing get-value)
#t #;(send display-testing get-value)
(and #t #;(send display-testing get-value)
(send collect-coverage get-value))
(get-classpath))]
[(settings)
@ -581,8 +581,8 @@
(send allow-testing set-value (profj-settings-allow-check? settings)))
(when (eq? level 'full)
(send allow-test set-value (profj-settings-allow-test? settings)))
(send display-testing set-value (profj-settings-run-tests? settings))
(if (send display-testing get-value)
#;(send display-testing set-value (profj-settings-run-tests? settings))
(if #t #;(send display-testing get-value)
(send collect-coverage set-value (profj-settings-coverage? settings))
(send collect-coverage enable #f))
(install-classpath (profj-settings-classpath settings))])))

View File

@ -437,7 +437,7 @@ class WeeklyPlanner{
(interact-test
'advanced
(list "(new int[2][])[0]")
(list null)
(list #\null)
"multi-dimension array - not all intialized")
(interact-test
@ -463,7 +463,7 @@ class WeeklyPlanner{
'advanced
(list "int[] x = new int[2];" "boolean[] y = new boolean[2];" "char[] z = new char[2];"
"Object[] o = new Object[2];" "x[0]" "y[0]" "z[0]" "o[0]")
(list '(void) '(void) '(void) '(void) 0 #f #\null null)
(list '(void) '(void) '(void) '(void) 0 #f #\null #\null)
"Array initialization checks")
(interact-test