From fbb0e6f9c2fe9321045708c1c9eab91627ad241e Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 16 Jan 2022 12:50:38 +0530
Subject: ccwl: Raise exceptions on output syntax errors.

* ccwl/ccwl.scm (output): Raise &ccwl-violation conditions on syntax
errors.
* tests/ccwl.scm (output): New function.
("output, when passed more than one positional argument, must raise a
&ccwl-violation condition", "output, when passed an unrecognized
keyword, must raise a &ccwl-violation condition", "output, when passed
multiple arguments to a unary keyword, must raise a &ccwl-violation
condition"): New tests.
---
 ccwl/ccwl.scm  | 36 +++++++++++++++++++++++++++++++++---
 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")
-- 
cgit v1.2.3