[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp e1a168f 3/5: * Add some 'cond-rw' pass related tests
From: |
Andrea Corallo |
Subject: |
feature/native-comp e1a168f 3/5: * Add some 'cond-rw' pass related tests |
Date: |
Sun, 1 Nov 2020 09:18:35 -0500 (EST) |
branch: feature/native-comp
commit e1a168f9a73cfb5a70d3f313e62dd1eaab14e214
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
* Add some 'cond-rw' pass related tests
* test/src/comp-tests.el (comp-tests-cond-rw-checked-function):
Declare var.
(comp-tests-cond-rw-checker-val): New function.
(comp-tests-cond-rw-checker-type): Declare var.
(comp-tests-cond-rw-checker-type): New function.
(comp-tests-cond-rw-0-var): Declare var.
(comp-tests-cond-rw-0, comp-tests-cond-rw-1, comp-tests-cond-rw-2)
(comp-tests-cond-rw-3, comp-tests-cond-rw-4)
(comp-tests-cond-rw-5): New testcases.
---
test/src/comp-tests.el | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 91 insertions(+)
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 4834e21..9c3c7f6 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -791,4 +791,95 @@ Return a list of results."
(should (subr-native-elisp-p (symbol-function
#'comp-tests-pure-fibn-entry-f)))
(should (= (comp-tests-pure-fibn-entry-f) 6765))))
+(defvar comp-tests-cond-rw-checked-function nil
+ "Function to be checked.")
+(defun comp-tests-cond-rw-checker-val (_)
+ "Check we manage to propagate the correct return value."
+ (should
+ (cl-some
+ #'identity
+ (comp-tests-map-checker
+ comp-tests-cond-rw-checked-function
+ (lambda (insn)
+ (pcase insn
+ (`(return ,mvar)
+ (and (comp-mvar-const-vld mvar)
+ (= (comp-mvar-constant mvar) 123)))))))))
+
+(defvar comp-tests-cond-rw-expected-type nil
+ "Type to expect in `comp-tests-cond-rw-checker-type'.")
+(defun comp-tests-cond-rw-checker-type (_)
+ "Check we manage to propagate the correct return type."
+ (should
+ (cl-some
+ #'identity
+ (comp-tests-map-checker
+ comp-tests-cond-rw-checked-function
+ (lambda (insn)
+ (pcase insn
+ (`(return ,mvar)
+ (eq (comp-mvar-type 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 'fixnum)
+ (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
+ (comp-final 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 'fixnum)
+ (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
+ (comp-final 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 'fixnum)
+ (comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
+ (comp-final 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 ((lexical-binding t)
+ (comp-tests-cond-rw-checked-function #'comp-tests-cond-rw-4-f)
+ (comp-tests-cond-rw-expected-type 'fixnum)
+ (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)))))
+
;;; comp-tests.el ends here