aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2019-07-09 22:28:29 +0200
committerAndrea Corallo2020-01-01 11:33:51 +0100
commitc1a738bd98f7eaaf4dcc87b0769dad2821178ab8 (patch)
treed9f4c45b2d934a3018d932c663656de0a840d6bb
parent0a227b6db46dcd5c4af0b6266d4f642b0c6157b5 (diff)
downloademacs-c1a738bd98f7eaaf4dcc87b0769dad2821178ab8.tar.gz
emacs-c1a738bd98f7eaaf4dcc87b0769dad2821178ab8.zip
update tests
-rw-r--r--lisp/emacs-lisp/comp.el20
-rw-r--r--test/src/comp-tests.el5
2 files changed, 11 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 93e3bf17b35..e3cb8684386 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -79,7 +79,7 @@ To be used when ncall-conv is nil.")
79 79
80(cl-defstruct (comp-mvar (:copier nil) (:constructor make--comp-mvar)) 80(cl-defstruct (comp-mvar (:copier nil) (:constructor make--comp-mvar))
81 "A meta-variable being a slot in the meta-stack." 81 "A meta-variable being a slot in the meta-stack."
82 (n nil :type number 82 (id nil :type number
83 :documentation "SSA number") 83 :documentation "SSA number")
84 (slot nil :type fixnum 84 (slot nil :type fixnum
85 :documentation "Slot position") 85 :documentation "Slot position")
@@ -139,8 +139,11 @@ To be used when ncall-conv is nil.")
139 (byte-compile (comp-func-symbol-name func))) 139 (byte-compile (comp-func-symbol-name func)))
140 (when comp-debug 140 (when comp-debug
141 (cl-prettyprint byte-compile-lap-output)) 141 (cl-prettyprint byte-compile-lap-output))
142 (setf (comp-func-args func) 142 (let ((lambda-list (aref (comp-func-byte-func func) 0)))
143 (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0))) 143 (if (fixnump lambda-list)
144 (setf (comp-func-args func)
145 (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0)))
146 (error "Can't native compile a non lexical scoped function")))
144 (setf (comp-func-ir func) byte-compile-lap-output) 147 (setf (comp-func-ir func) byte-compile-lap-output)
145 (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) 148 (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
146 func) 149 func)
@@ -163,7 +166,7 @@ To be used when ncall-conv is nil.")
163(defvar comp-func) 166(defvar comp-func)
164 167
165(cl-defun make-comp-mvar (&key slot const-vld constant type) 168(cl-defun make-comp-mvar (&key slot const-vld constant type)
166 (make--comp-mvar :n (cl-incf (comp-func-limple-cnt comp-func)) 169 (make--comp-mvar :id (cl-incf (comp-func-limple-cnt comp-func))
167 :slot slot :const-vld const-vld :constant constant 170 :slot slot :const-vld const-vld :constant constant
168 :type type)) 171 :type type))
169 172
@@ -207,11 +210,10 @@ To be used when ncall-conv is nil.")
207 "Push VAL into frame. 210 "Push VAL into frame.
208VAL is known at compile time." 211VAL is known at compile time."
209 (cl-incf (comp-sp)) 212 (cl-incf (comp-sp))
210 (let ((const (make-comp-mvar :slot (comp-sp) 213 (setf (comp-slot) (make-comp-mvar :slot (comp-sp)
211 :const-vld t 214 :const-vld t
212 :constant val))) 215 :constant val))
213 (setf (comp-slot) const) 216 (push (list '=const (comp-slot) val) comp-limple))
214 (push (list '=const (comp-slot) const) comp-limple)))
215 217
216(defun comp-push-block (bblock) 218(defun comp-push-block (bblock)
217 "Push basic block BBLOCK." 219 "Push basic block BBLOCK."
@@ -307,8 +309,6 @@ VAL is known at compile time."
307 309
308(defun native-compile (fun) 310(defun native-compile (fun)
309 "FUN is the function definition to be compiled into native code." 311 "FUN is the function definition to be compiled into native code."
310 (unless lexical-binding
311 (error "Can't native compile a non lexical scoped function"))
312 (if-let ((f (symbol-function fun))) 312 (if-let ((f (symbol-function fun)))
313 (progn 313 (progn
314 (when (byte-code-function-p f) 314 (when (byte-code-function-p f)
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index c6ee5b76855..8d3a0f507d3 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -26,6 +26,7 @@
26;;; Code: 26;;; Code:
27 27
28(require 'ert) 28(require 'ert)
29(require 'comp)
29 30
30(setq garbage-collection-messages t) 31(setq garbage-collection-messages t)
31 32
@@ -103,10 +104,6 @@
103 (defun comp-tests-varset-f () 104 (defun comp-tests-varset-f ()
104 (setq comp-tests-var1 55)) 105 (setq comp-tests-var1 55))
105 (comp-test-compile #'comp-tests-varset-f) 106 (comp-test-compile #'comp-tests-varset-f)
106((byte-constant 55 . 1)
107 (byte-dup . 0)
108 (byte-varset comp-tests-var1 . 0)
109 (byte-return . 0))
110 107
111 (comp-tests-varset-f) 108 (comp-tests-varset-f)
112 109