* Nativecomp testsuite rework for derived return type specifiers

As we have derived return type specifiers as some test for them.  Also
rewrite some propagation related test using return type specifiers too
as it's way more convenient.

	* test/src/comp-tests.el (fw-prop-1): Nit rename.
	(comp-tests-check-ret-type-spec): New function.
	(comp-tests-type-spec-tests): New variable.
	(comp-tests-cond-rw-0-var) Remove variable.
	(cond-rw-0, cond-rw-1, cond-rw-2, cond-rw-3, cond-rw-4, cond-rw-5)
	Remove tests as now covered by `comp-tests-check-ret-type-spec'.

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8bedad5db732c7a23d26d4dfda76c53937052c0f..23c4df882017188b71a9f61770b795160faad8e8 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -743,7 +743,7 @@ Return a list of results."
        (or (comp-tests-mentioned-p 'concat insn)
            (comp-tests-mentioned-p 'length insn)))))))
 
-(comp-deftest fw-prop ()
+(comp-deftest fw-prop-1 ()
   "Some tests for forward propagation."
   (let ((comp-speed 2)
         (comp-post-pass-hooks '((comp-final comp-tests-fw-prop-checker-1))))
@@ -757,6 +757,110 @@ Return a list of results."
     (should (subr-native-elisp-p (symbol-function #'comp-tests-fw-prop-1-f)))
     (should (= (comp-tests-fw-prop-1-f) 6))))
 
+(defun comp-tests-check-ret-type-spec (func-form type-specifier)
+  (let ((lexical-binding t)
+        (speed 2)
+        (comp-post-pass-hooks
+         `((comp-final
+            ,(lambda (_)
+               (let ((f (gethash (comp-c-func-name (cadr func-form) "F" t)
+                                 (comp-ctxt-funcs-h comp-ctxt))))
+                 (should (equal (comp-func-ret-type-specifier f)
+                                type-specifier))))))))
+    (eval func-form t)
+    (native-compile (cadr func-form))))
+
+(defconst comp-tests-type-spec-tests
+  `(((defun comp-tests-ret-type-spec-0-f (x)
+       x)
+     (t))
+
+    ((defun comp-tests-ret-type-spec-1-f ()
+       1)
+     (integer 1 1))
+
+    ((defun comp-tests-ret-type-spec-2-f (x)
+       (if x 1 3))
+     (or (integer 1 1) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-3-f (x)
+       (let (y)
+         (if x
+             (setf y 1)
+           (setf y 2))
+         y))
+     (integer 1 2))
+
+    ((defun comp-tests-ret-type-spec-4-f (x)
+       (let (y)
+         (if x
+             (setf y 1)
+           (setf y 3))
+         y))
+     (or (integer 1 1) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-5-f (x)
+       (if x
+           (list x)
+         3))
+     (or cons (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-6-f (x)
+       (if x
+           'foo
+         3))
+     (or (member foo) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-7-1-f (x)
+       (if (eq x 3)
+           x
+         'foo))
+     (or (member foo) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-7-2-f (x)
+       (if (eq 3 x)
+           x
+         'foo))
+     (or (member foo) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-8-1-f (x)
+       (if (= x 3)
+           x
+         'foo))
+     (or (member foo) (integer 3 3)))
+
+    ((defun comp-tests-ret-type-spec-8-2-f (x)
+       (if (= 3 x)
+           x
+         'foo))
+     (or (member foo) (integer 3 3)))
+
+    ;; FIXME returning ATM (or t (member foo))
+    ;; ((defun comp-tests-ret-type-spec-8-3-f (x)
+    ;;    (if (= x 3)
+    ;;        'foo
+    ;;      x))
+    ;;  (or number (member foo)))
+
+    ((defun comp-tests-ret-type-spec-8-4-f (x y)
+       (if (= x y)
+           x
+         'foo))
+     (or number (member foo)))
+
+    ((defun comp-tests-ret-type-spec-9-1-f (x)
+       (comp-hint-fixnum y))
+     (integer ,most-negative-fixnum ,most-positive-fixnum))
+
+    ((defun comp-tests-ret-type-spec-9-1-f (x)
+       (comp-hint-cons x))
+     (cons))))
+
+(comp-deftest ret-type-spec ()
+  "Some derived return type specifier tests."
+  (cl-loop for (func-form  type-spec) in comp-tests-type-spec-tests
+           do (comp-tests-check-ret-type-spec func-form type-spec)))
+
 (defun comp-tests-pure-checker-1 (_)
   "Check that inside `comp-tests-pure-caller-f' `comp-tests-pure-callee-f' is
  folded."
@@ -826,67 +930,6 @@ Return a list of results."
           (equal (comp-mvar-typeset mvar)
                  comp-tests-cond-rw-expected-type))))))))
 
-(defvar comp-tests-cond-rw-0-var)
-(comp-deftest cond-rw-0 ()
-  "Check we do not miscompile some simple functions."
-  (let ((lexical-binding t))
-    (let ((f (native-compile '(lambda (l)
-                                (when (eq (car l) 'x)
-                                  (cdr l))))))
-      (should (subr-native-elisp-p f))
-      (should (eq (funcall f '(x . y)) 'y))
-      (should (null (funcall f '(z . y)))))
-
-    (should
-     (subr-native-elisp-p
-      (native-compile '(lambda () (if (eq comp-tests-cond-rw-0-var 123) 5 10)))))))
-
-(comp-deftest cond-rw-1 ()
-  "Test cond-rw pass allow us to propagate type+val under `eq' tests."
-  (let ((lexical-binding t)
-        (comp-tests-cond-rw-expected-type '(integer))
-        (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
-                                            comp-tests-cond-rw-checker-val))))
-    (subr-native-elisp-p (native-compile '(lambda (x) (if (eq x 123) x t))))
-    (subr-native-elisp-p (native-compile '(lambda (x) (if (eq 123 x) x t))))))
-
-(comp-deftest cond-rw-2 ()
-  "Test cond-rw pass allow us to propagate type+val under `=' tests."
-  (let ((lexical-binding t)
-        (comp-tests-cond-rw-expected-type '(integer))
-        (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
-                                            comp-tests-cond-rw-checker-val))))
-    (subr-native-elisp-p (native-compile '(lambda (x) (if (= x 123) x t))))))
-
-(comp-deftest cond-rw-3 ()
-  "Test cond-rw pass allow us to propagate type+val under `eql' tests."
-  (let ((lexical-binding t)
-        (comp-tests-cond-rw-expected-type '(integer))
-        (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
-                                            comp-tests-cond-rw-checker-val))))
-    (subr-native-elisp-p (native-compile '(lambda (x) (if (eql 123 x) x t))))))
-
-(comp-deftest cond-rw-4 ()
-  "Test cond-rw pass allow us to propagate type under `=' tests."
-  (let ((lexical-binding t)
-        (comp-tests-cond-rw-expected-type '(number))
-        (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type))))
-    (subr-native-elisp-p (native-compile '(lambda (x y) (if (= x y) x t))))))
-
-(comp-deftest cond-rw-5 ()
-  "Test cond-rw pass allow us to propagate type under `=' tests."
-  (let ((comp-tests-cond-rw-checked-function #'comp-tests-cond-rw-4-f)
-        (comp-tests-cond-rw-expected-type '(integer))
-        (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type))))
-    (eval '(defun comp-tests-cond-rw-4-f (x y)
-             (declare (speed 3))
-             (if (= x (comp-hint-fixnum y))
-                 x
-               t))
-          t)
-    (native-compile #'comp-tests-cond-rw-4-f)
-    (should (subr-native-elisp-p (symbol-function #'comp-tests-cond-rw-4-f)))))
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Range propagation tests. ;;