summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ccwl/ccwl.scm36
-rw-r--r--tests/ccwl.scm18
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")