op: tests, and fix (op progn ...) situation

* share/txr/stdlib/op.tl (op-expand): For the sake of special
processing applied to support the lop operator, the code
assumes that the expanded syntax-2 is a list with at least two
elements, such that we can do (cddr syntax-2). This is not
true for instance in (op progn).

* tests/012/op.tl: New file.

2 files changed, 73 insertions, 1 deletions

diff --git a/share/txr/stdlib/op.tl b/share/txr/stdlib/op.tl
index 5c231645..809a7f09 100644
--- a/share/txr/stdlib/op.tl
+++ b/share/txr/stdlib/op.tl
@@ -119,7 +119,8 @@
          (rec (slot ctx 'rec))
          (recvar (slot ctx 'recvar))
          (rest-sym (sys:ensure-op-arg ctx 0))
-         (lambda-interior (let ((fargs (cdr (cdr syntax-2))))
+         (lambda-interior (let ((fargs (tree-case syntax-2
+                                         ((a b . fa) fa))))
                             (cond
                               ((and (eq sym 'lop) fargs)
                                (let ((fargs-l1 (mapcar (lambda (farg)
diff --git a/tests/012/op.tl b/tests/012/op.tl
new file mode 100644
index 00000000..0fffb6ee
--- /dev/null
+++ b/tests/012/op.tl
@@ -0,0 +1,71 @@
+(load "../common")
+
+(defun fi (fun)
+  (assert (zerop (fun-optparam-count fun)))
+  (list (fun-fixparam-count fun)
+        (fun-variadic fun)))
+
+(mtest
+  (fi (op)) :error
+  (fi (op list)) (0 t)
+  (fi (op list @1)) (1 t)
+  (fi (op list @2)) (2 t)
+  (fi (op list @42)) (42 t)
+  (fi (op list @rest)) (0 t)
+  (fi (op list @1 @rest)) (1 t)
+  (fi (op list @2 @rest)) (2 t)
+  (fi (op list @42 @rest)) (42 t)
+  (fi (op list @1 @3 @rest @2)) (3 t))
+
+(mtest
+  (fi (do)) :error
+  (fi (do progn)) (1 t)
+  (fi (do progn @1)) (1 t)
+  (fi (do progn @2)) (2 t)
+  (fi (do progn @42)) (42 t)
+  (fi (do progn @rest)) (0 t)
+  (fi (do progn @1 @rest)) (1 t)
+  (fi (do progn @2 @rest)) (2 t)
+  (fi (do progn @42 @rest)) (42 t)
+  (fi (do progn @1 @3 @rest @2)) (3 t))
+
+(mtest
+  (fi (do if)) (1 t)
+  (fi (do if @1)) (1 t)
+  (fi (do if @2)) (2 t)
+  (fi (do if @42)) (42 t)
+  (fi (do if @rest)) (0 t)
+  (fi (do if @1 @rest)) (1 t)
+  (fi (do if @2 @rest)) (2 t)
+  (fi (do if @42 @rest)) (42 t)
+  (fi (do if @1 @3 @rest @2)) (3 t))
+
+(defun y (f)
+  [(op @1 @1)
+   (op f (op [@@1 @@1]))])
+
+(defun fac (f)
+  (do if (zerop @1)
+         1
+         (* @1 [f (- @1 1)])))
+
+(defun fac-y (n)
+  [(y (do do if (zerop @1)
+               1
+               (* @1 [@@1 (- @1 1)]))) n])
+
+(defun fac-r (n)
+  [(do if (zerop @1) 1 (* @1 [@rec (pred @1)])) n])
+
+(defun fac-r2 (n)
+  [(do if (zerop @1) 1 (* @1 @(rec (pred @1)))) n])
+
+(mtest
+  [[y fac] 4] 24
+  (fac-y 4) 24
+  (fac-r 4) 24
+  (fac-r2 4) 24)
+
+(mtest
+  (flow 1 (+ 2) [dup *] (let ((x @1)) x)) 9
+  (flow #S(time year 2021) .year succ) 2022)