From b44c20d3c3ab8917cd568856d7433f299f91941a Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Mon, 12 May 2008 22:34:33 +0000 Subject: [PATCH] Clarified grammars Clarified display of field-based failures in test report svn: r9818 --- collects/profj/comb-parsers/parser-units.scm | 8 +-- collects/profj/parsers/advanced-parser.ss | 2 +- .../parsers/intermediate-access-parser.ss | 2 +- collects/profj/parsers/intermediate-parser.ss | 2 +- collects/test-engine/java-tests.scm | 66 +++++++++++++------ 5 files changed, 52 insertions(+), 28 deletions(-) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index 16e0c8aa8e..647518c71c 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -737,7 +737,7 @@ (define statement (statement-c #f)) - (define field (make-field #f (value+name-type prim-type) (eta expression) #t)) + (define field (make-field #f (value+name-type prim-type) (eta expression) #f)) (define method-sig-no-abs (method-signature #f (method-type (value+name-type prim-type)) @@ -845,7 +845,7 @@ (define statement (statement-c #f)) - (define field (make-field access-mods (value+name-type prim-type) (eta expression) #t)) + (define field (make-field access-mods (value+name-type prim-type) (eta expression) #f)) (define method-sig-no-abs (method-signature access-mods (method-type (value+name-type prim-type)) @@ -975,7 +975,7 @@ (define field (make-field (global-mods access-mods) (array-type (value+name-type prim-type)) - (eta (choose (expression array-init) "field initializer")) #t)) + (eta (choose (expression array-init) "field initializer")) #f)) (define method-sig-no-abs (method-signature (global-mods access-mods) @@ -1004,7 +1004,7 @@ (repeat-greedy (choose ((sequence (method-sig-no-abs SEMI_COLON) id "method header") (make-field (global-mods access-mods) (array-type (value+name-type prim-type)) - (eta expression) #t)) + (eta expression) #f)) "interface member definition")))) (define class diff --git a/collects/profj/parsers/advanced-parser.ss b/collects/profj/parsers/advanced-parser.ss index 47ba9791b7..4646355af8 100644 --- a/collects/profj/parsers/advanced-parser.ss +++ b/collects/profj/parsers/advanced-parser.ss @@ -234,7 +234,7 @@ (VariableDeclarators [(VariableDeclarator) (list $1)] - [(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) + #;[(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) (VariableDeclarator [(VariableDeclaratorId) $1] diff --git a/collects/profj/parsers/intermediate-access-parser.ss b/collects/profj/parsers/intermediate-access-parser.ss index 590c478044..c4a9cb6112 100644 --- a/collects/profj/parsers/intermediate-access-parser.ss +++ b/collects/profj/parsers/intermediate-access-parser.ss @@ -215,7 +215,7 @@ (VariableDeclarators [(VariableDeclarator) (list $1)] - [(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) + #;[(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) (VariableDeclarator [(VariableDeclaratorId) $1] diff --git a/collects/profj/parsers/intermediate-parser.ss b/collects/profj/parsers/intermediate-parser.ss index 6276cc2e6b..9a9e63d970 100644 --- a/collects/profj/parsers/intermediate-parser.ss +++ b/collects/profj/parsers/intermediate-parser.ss @@ -212,7 +212,7 @@ (VariableDeclarators [(VariableDeclarator) (list $1)] - [(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) + #;[(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) (VariableDeclarator [(VariableDeclaratorId) $1] diff --git a/collects/test-engine/java-tests.scm b/collects/test-engine/java-tests.scm index 314ba2de65..ee90f0c0db 100644 --- a/collects/test-engine/java-tests.scm +++ b/collects/test-engine/java-tests.scm @@ -72,7 +72,7 @@ [test-class (cadr test)] [test-src (caddr test)]) (send test-info add-test-class test-name test-src) - (send test-info add-testcase 'fields test-src) + (send test-info add-inits test-name test-src) (let ([test-obj (make-object test-class)]) (send test-info complete-testcase #t) (set! test-objs (cons test-obj test-objs)) @@ -115,9 +115,13 @@ (let ([n (symbol->string name)]) (regexp-match? "^(?:tst|tet|Test|tes)" n))))) -(define-struct test-stat (name src tests cases) #:mutable) +;(make-test-stat String [U String Src] [listof tests-data] init-testcase-stat [listof tc-stat]) +(define-struct test-stat (name src tests init cases) #:mutable) (define-struct tests-data (c-name methods method-srcs)) -(define-struct testcase-stat (name src pass? checks) #:mutable) +;(make-tc-stat String [U String Src] [listof check-info]) +(define-struct tc-stat (name src checks) #:mutable) +(define-struct (testcase-stat tc-stat) (pass?) #:mutable) +(define-struct (init-testcase-stat tc-stat) () #:mutable) (define java-test-info% (class* test-info-base% () @@ -129,7 +133,7 @@ (define current-test #f) (define/pubment (add-test-class name src) - (set! current-test (make-test-stat name src null null)) + (set! current-test (make-test-stat name src null #f null)) (inner (void) add-test-class name src)) (define/public (add-tests-info tests test-methods test-method-srcs) @@ -146,25 +150,32 @@ ;add-testcase: (U string 'fields) (U string src) -> void ;adds testcase specific information to the info storage (define/pubment (add-testcase name src) - (set! current-testcase (make-testcase-stat name src #t null)) - (unless (eq? name 'fields) (add-test)) + (set! current-testcase (make-testcase-stat name src null #t)) + (add-test) (inner (void) add-testcase name src)) + + (define/pubment (add-inits name src) + (set! current-testcase (make-init-testcase-stat name src null)) + (inner (void) add-inits name src)) (define/pubment (complete-testcase pass?) - (set-testcase-stat-pass?! current-testcase pass?) - (unless (eq? (testcase-stat-name current-testcase) 'fields) - (unless pass? (test-failed (get-current-testcase)))) - (set-test-stat-cases! current-test (cons current-testcase - (test-stat-cases current-test))) + (cond + [(testcase-stat? current-testcase) + (set-testcase-stat-pass?! current-testcase pass?) + (unless pass? (test-failed (get-current-testcase))) + (set-test-stat-cases! current-test (cons current-testcase + (test-stat-cases current-test)))] + [(init-testcase-stat? current-testcase) + (set-test-stat-init! current-test current-testcase)]) (inner (void) complete-testcase pass?)) (define/public (get-current-testcase) current-testcase) (define/augment (check-failed msg src) (when current-testcase - (set-testcase-stat-checks! + (set-tc-stat-checks! current-testcase (cons (make-failed-check src msg) - (testcase-stat-checks current-testcase)))) + (tc-stat-checks current-testcase)))) (inner (void) check-failed msg src)) (define/public (format-value value) @@ -203,7 +214,7 @@ (inner (void) add-testcase name src)) (define/augment (complete-testcase pass?) (for ([a analyses]) - (send a de-register-testcase (testcase-stat-src (get-current-testcase)))) + (send a de-register-testcase (tc-stat-src (get-current-testcase)))) (inner (void) complete-testcase pass?)) (super-instantiate ()))) @@ -223,10 +234,17 @@ (send editor insert "\n")) (define/pubment (insert-testcase-name editor testcase-stat src-editor) - (send editor insert (format "~a ~a" - (testcase-stat-name testcase-stat) - (if (testcase-stat-pass? testcase-stat) - "succeeded!" "failed"))) + (cond + [(testcase-stat? testcase-stat) + (send editor insert (format "~a ~a" + (tc-stat-name testcase-stat) + (if (testcase-stat-pass? testcase-stat) + "succeeded!" "failed.")))] + [(init-testcase-stat? testcase-stat) + (send editor insert (format "~a ~a" + (tc-stat-name testcase-stat) + " contained failed checks."))] + [else (void)]) (inner (void) insert-testcase-name editor testcase-stat src-editor) (next-line editor)) @@ -240,6 +258,12 @@ (for ([test (send test-info get-test-results)]) (send editor insert "\n") (send this insert-test-name editor test src-editor) + (when (and (test-stat-init test) + (not (null? (tc-stat-checks (test-stat-init test))))) + (send this insert-testcase-name editor (test-stat-init test) src-editor) + (send this display-check-failures (tc-stat-checks (test-stat-init test)) + editor test-info src-editor) + (next-line editor)) (unless (null? (test-stat-cases test)) (let* ([run-tests (reverse (test-stat-cases test))] [num-tests (length run-tests)] @@ -258,10 +282,10 @@ (next-line editor) (for ([testcase run-tests]) (send this insert-testcase-name editor testcase src-editor) - (if (null? (testcase-stat-checks testcase)) + (if (null? (tc-stat-checks testcase)) (send editor insert "All checks succeeded!\n") (send this display-check-failures - (testcase-stat-checks testcase) + (tc-stat-checks testcase) editor test-info src-editor)) (next-line editor)) (inner (void) insert-tests editor test-info src-editor))))))) @@ -325,7 +349,7 @@ (define/augride (insert-testcase-name editor testcase-stat src-editor) (insert-covered-button editor coverage-info - (testcase-stat-src testcase-stat) + (tc-stat-src testcase-stat) src-editor #t)) (super-instantiate ())))