ccwl: Raise lambda** and syntax-lambda** errors as exceptions.

* ccwl/conditions.scm (&unrecognized-keyword-assertion,
&invalid-keyword-arity-assertion,
&invalid-positional-arguments-arity-assertion): New conditions.
* ccwl/utils.scm: Import (rnrs conditions), (rnrs exceptions)
and (ccwl conditions).
(group-keyword-arguments): Raise &invalid-keyword-arity-assertion on
error.
(lambda**, syntax-lambda**): Raise &unrecognized-keyword-assertion,
&invalid-keyword-arity-assertion and
&invalid-positional-arguments-arity-assertion on error.
* tests/utils.scm: Import (rnrs conditions), (rnrs exceptions), (srfi
srfi-1) and (ccwl conditions).
("lambda** should raise an &unrecognized-keyword-assertion on
unrecognized keywords in arguments with syntax objects as irritants"):
Check for &unrecognized-keyword-assertion.
("Unrecognized keyword argument passed to lambda** should raise an
&unrecognized-keyword-assertion condition", "Unary lambda** keyword
argument passed multiple arguments should raise an
&invalid-keyword-arity-assertion condition", "Wrong number of
positional arguments to lambda** should raise an
&invalid-positional-arguments-arity-assertion condition",
"syntax-lambda** should raise an &unrecognized-keyword-assertion on
unrecognized keywords in arguments", "Unrecognized keyword argument
passed to syntax-lambda** should raise an
&unrecognized-keyword-assertion condition with syntax objects as
irritants", "Unary syntax-lambda** keyword argument passed multiple
arguments should raise an &invalid-keyword-arity-assertion condition",
"Wrong number of positional arguments to syntax-lambda** should raise
an &invalid-positional-arguments-arity-assertion condition"): New
tests.

1 files changed, 69 insertions, 5 deletions

diff --git a/tests/utils.scm b/tests/utils.scm
index 223e7cd..8a1e6a1 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -16,8 +16,12 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with ccwl.  If not, see <https://www.gnu.org/licenses/>.
 
-(use-modules (srfi srfi-64)
+(use-modules (rnrs conditions)
+             (rnrs exceptions)
+             (srfi srfi-1)
+             (srfi srfi-64)
              (srfi srfi-71)
+             (ccwl conditions)
              (ccwl utils))
 
 (test-begin "utils")
@@ -79,10 +83,15 @@
   ((lambda** (#:key* foo)
      foo)))
 
-(test-error "lambda** should error out on unrecognized keywords in arguments" #t
-  (macroexpand
-   '(lambda** (#:key foo #:foo bar)
-      foo)))
+(test-assert "lambda** should raise an &unrecognized-keyword-assertion on unrecognized keywords in arguments with syntax objects as irritants"
+  (guard (exception
+          (else (and (unrecognized-keyword-assertion? exception)
+                     ;; We check with NOT keyword? because we have no
+                     ;; way of directly checking for syntax?.
+                     (not (any keyword? (condition-irritants exception))))))
+    (macroexpand
+     '(lambda** (#:key foo #:foo bar)
+        foo))))
 
 (test-equal "Allow other keys in lambda**"
   1
@@ -90,6 +99,27 @@
      foo)
    #:foo 1 #:bar 2))
 
+(test-assert "Unrecognized keyword argument passed to lambda** should raise an &unrecognized-keyword-assertion condition"
+  (guard (exception
+          (else (unrecognized-keyword-assertion? exception)))
+    ((lambda** (spam ham #:key eggs)
+       spam)
+     1 2 #:foo 123)))
+
+(test-assert "Unary lambda** keyword argument passed multiple arguments should raise an &invalid-keyword-arity-assertion condition"
+  (guard (exception
+          (else (invalid-keyword-arity-assertion? exception)))
+    ((lambda** (spam ham #:key eggs)
+       (list spam ham eggs))
+     1 2 #:eggs 123 345)))
+
+(test-assert "Wrong number of positional arguments to lambda** should raise an &invalid-positional-arguments-arity-assertion condition"
+  (guard (exception
+          (else (invalid-positional-arguments-arity-assertion? exception)))
+    ((lambda** (spam ham #:key eggs)
+       spam)
+     1 #:eggs 123)))
+
 (test-assert "syntax-lambda**"
   (equal? (list #'1 #'2 #'123 (list #'1 #'2 #'3))
           ((syntax-lambda** (a b #:key foo #:key* bar)
@@ -111,6 +141,40 @@
              foo)
            #'#:foo #'1 #'#:bar #'2)))
 
+(test-assert "syntax-lambda** should raise an &unrecognized-keyword-assertion on unrecognized keywords in arguments"
+  (guard (exception
+          (else (unrecognized-keyword-assertion? exception)))
+    (macroexpand
+     '(syntax-lambda** (#:key foo #:foo bar)
+        foo))))
+
+(test-assert "Unrecognized keyword argument passed to syntax-lambda** should raise an &unrecognized-keyword-assertion condition with syntax objects as irritants"
+  (guard (exception
+          (else (and (unrecognized-keyword-assertion? exception)
+                     ;; We check with NOT keyword? because we have no
+                     ;; way of directly checking for syntax?.
+                     (not (any keyword? (condition-irritants exception))))))
+    ((syntax-lambda** (spam ham #:key eggs)
+       spam)
+     #'1 #'2 #'#:foo #'123)))
+
+(test-assert "Unary syntax-lambda** keyword argument passed multiple arguments should raise an &invalid-keyword-arity-assertion condition"
+  (guard (exception
+          (else (and (invalid-keyword-arity-assertion? exception)
+                     ;; We check with NOT keyword? because we have no
+                     ;; way of directly checking for syntax?.
+                     (not (any keyword? (condition-irritants exception))))))
+    ((syntax-lambda** (spam ham #:key eggs)
+       (list spam ham eggs))
+     #'1 #'2 #'#:eggs #'123 #'345)))
+
+(test-assert "Wrong number of positional arguments to syntax-lambda** should raise an &invalid-positional-arguments-arity-assertion condition"
+  (guard (exception
+          (else (invalid-positional-arguments-arity-assertion? exception)))
+    ((syntax-lambda** (spam ham #:key eggs)
+       spam)
+     #'1 #'#:eggs #'123)))
+
 (test-equal "filter-mapi"
   '(1 3 5 7 9)
   (filter-mapi (lambda (item index)