feature/native-comp 7e004d2 4/5: * Add a test to verify tail recursion elimination

[Andrea Corallo]

branch: feature/native-comp
commit 7e004d24a4abaa4b5aa9f0f1cd4bc70264396ad5
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    * Add a test to verify tail recursion elimination
    
        * test/src/comp-tests.el (comp-tests-tco): Compile a recursive
        functions at speed 3 and verify the tail recursion elimination.
        (comp-tests-tco-checker, comp-tests-mentioned-p)
        (comp-tests-mentioned-p-1): New support functions.
---
 test/src/comp-tests.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 66f7d8c..fd1c513 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -583,4 +583,52 @@ 
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
   (should (equal (comp-tests-cl-uninterned-arg-parse-f 1 2)
                  '(1 2))))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Middle-end specific tests. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun comp-tests-mentioned-p-1 (x insn)
+  (cl-loop for y in insn
+           when (cond
+                 ((consp y) (comp-tests-mentioned-p x y))
+                 ((and (comp-mvar-p y) (comp-mvar-const-vld y))
+                  (equal (comp-mvar-constant y) x))
+                 (t (equal x y)))
+             return t))
+
+(defun comp-tests-mentioned-p (x insn)
+  "Check if X is actively mentioned in INSN."
+  (unless (eq (car-safe insn)
+              'comment)
+    (comp-tests-mentioned-p-1 x insn)))
+
+(defun comp-tests-tco-checker (_)
+  "Check that inside `comp-tests-tco-f' we have no recursion."
+  (should-not
+   (cl-loop
+    named checker-loop
+    with func-name = (comp-c-func-name 'comp-tests-tco-f "F" t)
+    with f = (gethash func-name (comp-ctxt-funcs-h comp-ctxt))
+    for bb being each hash-value of (comp-func-blocks f)
+    do (cl-loop
+        for insn in (comp-block-insns bb)
+        when (or (comp-tests-mentioned-p 'comp-tests-tco-f insn)
+                 (comp-tests-mentioned-p func-name insn))
+        do (cl-return-from checker-loop 'mentioned)))))
+
+(ert-deftest comp-tests-tco ()
+  "Check for tail recursion elimination."
+  (let ((comp-speed 3)
+        (comp-post-pass-hooks '((comp-tco comp-tests-tco-checker)
+                                (comp-final comp-tests-tco-checker))))
+    (eval '(defun comp-tests-tco-f (a b count)
+             (if (= count 0)
+                 b
+               (comp-tests-tco-f (+ a b) a (- count 1))))
+          t)
+    (load (native-compile #'comp-tests-tco-f))
+    (should (subr-native-elisp-p (symbol-function #'comp-tests-tco-f)))
+    (should (= (comp-tests-tco-f 1 0 10) 55))))
+
 ;;; comp-tests.el ends here