mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-23 21:13:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

tests: add regression test for issue #577

Browse source
This commit is contained in:
Marius Gerbershagen 2020-05-01 11:59:00 +02:00
parent c6b4296bb8
commit fc5a9ad58c
1 changed files with 76 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

76
src/tests/normal-tests/compiler.lsp
View file

@ -1812,3 +1812,79 @@
`(defclass class () ())
`(defmethod method ()
(load-time-value (find-class class))))))
;;; Date 2020-05-01
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/issues/577
;;; Description
;;;
;;; Inlining of closures did not work properly if closed over
;;; variables were in the scope in which the inlined function was
;;; called.
(test cmp.0079.inline-closure
;; local function
(is (equal
(funcall (compile
nil
(lambda ()
(let ((b 123)
results)
(flet ((set-b (x) (setf b x))
(get-b () b))
(declare (inline set-b get-b))
(push (get-b) results)
(push b results)
(let ((b 345))
(push (get-b) results)
(push b results)
(set-b 0)
(push (get-b) results)
(push b results))
(push (get-b) results)
(push b results))
(nreverse results)))))
'(123 123 123 345 0 345 0 0)))
;; global function from bytecodes compiler, proclaimed inline
(ext:with-clean-symbols (set-b get-b)
(proclaim '(inline set-b get-b))
(eval
'(let ((b 123))
(defun set-b (x)
(setf b x))
(defun get-b () b)))
(is (equal
(funcall (compile
nil
(lambda ()
(let (results)
(push (get-b) results)
(let ((b 345))
(push (get-b) results)
(push b results)
(set-b 0)
(push (get-b) results)
(push b results))
(push (get-b) results)
(nreverse results)))))
'(123 123 345 0 345 0))))
;; global function in same file, declaimed inline
(load (with-compiler ("inline-closure.lsp")
'(in-package #:cl-test)
'(declaim (inline set-b.0079 get-b.0079))
'(let ((b 123))
(defun set-b.0079 (x)
(setf b x))
(defun get-b.0079 () b))
'(defun foo.0079 ()
(let (results)
(push (get-b.0079) results)
(let ((b 345))
(push (get-b.0079) results)
(push b results)
(set-b.0079 0)
(push (get-b.0079) results)
(push b results))
(push (get-b.0079) results)
(nreverse results)))))
(is (equal
(funcall 'foo.0079)
'(123 123 345 0 345 0))))