diff options
| -rw-r--r-- | ccwl/ccwl.scm | 36 | ||||
| -rw-r--r-- | tests/ccwl.scm | 18 |
2 files changed, 51 insertions, 3 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index be87467..c366d3d 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -149,9 +149,39 @@ "Return syntax to build an <output> object from OUTPUT-SPEC." (syntax-case output-spec () ((id args ...) (identifier? #'id) - (apply (syntax-lambda** (id #:key (type #'File) binding source #:key* other) - #`(make-output '#,id '#,type #,binding #,source '#,other)) - #'(id args ...))) + (guard (exception + ((unrecognized-keyword-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ((irritant _ ...) + (condition (ccwl-violation irritant) + (formatted-message "Unrecognized keyword argument ~a in output" + (syntax->datum irritant))))))) + ((invalid-keyword-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra arguments, not just the + ;; first one. + ((keyword _ extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra argument ~a for unary keyword argument ~a" + (syntax->datum extra) + (syntax->datum keyword))))))) + ((invalid-positional-arguments-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra positional arguments, not + ;; just the first one. + ((id extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra positional argument ~a in output" + (syntax->datum extra)))) + (() + (condition (ccwl-violation output-spec) + (formatted-message "Output has no identifier"))))))) + (apply (syntax-lambda** (id #:key (type #'File) binding source #:key* other) + #`(make-output '#,id '#,type #,binding #,source '#,other)) + #'(id args ...)))) (id (identifier? #'id) (output #'(id))) (_ (error "Invalid output:" (syntax->datum output-spec))))) diff --git a/tests/ccwl.scm b/tests/ccwl.scm index bc9fb01..d667b32 100644 --- a/tests/ccwl.scm +++ b/tests/ccwl.scm @@ -24,6 +24,9 @@ (define input (@@ (ccwl ccwl) input)) +(define output + (@@ (ccwl ccwl) output)) + (test-begin "ccwl") (test-assert "stdin input should not have inputBinding" @@ -67,4 +70,19 @@ (else (ccwl-violation? exception))) (input #'(message #:type int string)))) +(test-assert "output, when passed more than one positional argument, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (output #'(message string)))) + +(test-assert "output, when passed an unrecognized keyword, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (output #'(message #:foo string)))) + +(test-assert "output, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (output #'(message #:type int string)))) + (test-end "ccwl") |