sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tests: compiler: improve make-load-form tests

Browse source 
Also check for identical objects in CMP.0030.MAKE-LOAD-FORM

Be more aware of the bcmp in the test CMP.0076.MAKE-LOAD-FORM-NON-EQ - bytecmp
fails the test in a different manner, so remove the remark that a part of the
test pass, and change the description to 1) explain the test, 2) explain the
ccmp's failure mode.
This commit is contained in:
Marius Gerbershagen 2020-09-18 21:30:50 +02:00
parent bf664c1887
commit b20a675f64
1 changed files with 18 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -739,16 +739,16 @@
(with-compiler ("make-load-form.lsp") (with-compiler ("make-load-form.lsp")
"(in-package cl-test)" "(in-package cl-test)"
"(eval-when (:compile-toplevel) "(eval-when (:compile-toplevel)
(defparameter s4.0030 (make-instance 'compiler-test-class)) (defparameter s4.0030 (make-instance 'compiler-test-class))
(defparameter s5.0030 (make-instance 'compiler-test-class)) (defparameter s5.0030 (make-instance 'compiler-test-class))
(setf (compiler-test-parent s5.0030) s4.0030) (setf (compiler-test-parent s5.0030) s4.0030)
(setf (compiler-test-children s4.0030) (list s5.0030)))" (setf (compiler-test-children s4.0030) (list s5.0030)))"
"(defparameter a.0030 '#.s5.0030)" "(defparameter a.0030 '#.s5.0030)"
"(defparameter b.0030 '#.s4.0030)" "(defparameter b.0030 '#.s4.0030)"
"(defparameter c.0030 '#.s5.0030)" "(defparameter c.0030 '#.s5.0030)"
"(defun foo.0030 () "(defun foo.0030 ()
(let ((*print-circle* t)) (let ((*print-circle* t))
(with-output-to-string (s) (princ '#1=(1 2 3 #.s4.0030 #1#) s))))") (with-output-to-string (s) (princ '#1=(1 2 3 #.s4.0030 #1#) s))))")
(declare (ignore output)) (declare (ignore output))
(load file) (load file)
(delete-file "make-load-form.lsp") (delete-file "make-load-form.lsp")
@ -757,7 +757,8 @@
(is (and (search "#1=(1 2 3 #<a CL-TEST::COMPILER-TEST-CLASS" str) (is (and (search "#1=(1 2 3 #<a CL-TEST::COMPILER-TEST-CLASS" str)
(search "> #1#)" str)))) (search "> #1#)" str))))
(is (eq (compiler-test-parent a.0030) b.0030)) (is (eq (compiler-test-parent a.0030) b.0030))
(is (eq (first (compiler-test-children b.0030)) a.0030))) (is (eq (first (compiler-test-children b.0030)) a.0030))
(is (eq a.0030 c.0030)))
;;; Date: 9/06/2006 (Pascal Costanza) ;;; Date: 9/06/2006 (Pascal Costanza)
;;; Fixed: 13/06/2006 (juanjo) ;;; Fixed: 13/06/2006 (juanjo)
@ -1707,14 +1708,16 @@
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/565 ;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/565
;;; Description ;;; Description
;;; ;;;
;;; COMPILE-FILE produces two vectors VV and VVtemp which ;;; This test checks whether the same constant is coalesced to the EQ
;;; represent the fasl data segment. The latter is deallocated ;;; value among three distinct top-level forms.
;;; after all top-level forms are evaluated. As compiler processes ;;;
;;; them currently if the object is first pushed to the temporary ;;; ccmp's COMPILE-FILE produces two vectors VV and VVtemp which represent
;;; segment and then we try to add it to the permanent segment we ;;; the fasl data segment. The latter is deallocated after all top-level
;;; have two versions of the same objects which are not EQ. File ;;; forms are evaluated. As compiler processes them currently if the
;;; src/cmp/cmpwt.lsp has an appropriate FIXME in the ADD-OBJECT ;;; object is first pushed to the temporary segment and then we try to add
;;; function definition. ;;; it to the permanent segment we have two versions of the same objects
;;; which are not EQ. File src/cmp/cmpwt.lsp has an appropriate FIXME in
;;; the ADD-OBJECT function definition.
(test cmp.0076.make-load-form-non-eq (test cmp.0076.make-load-form-non-eq
(multiple-value-bind (file output) (multiple-value-bind (file output)
(with-compiler ("make-temp.lsp") (with-compiler ("make-temp.lsp")
@ -1745,8 +1748,6 @@
(delete-file file)) (delete-file file))
(multiple-value-bind (x a b) (foo) (multiple-value-bind (x a b) (foo)
(is (eq x a) "~a is not eq to ~a" x a) (is (eq x a) "~a is not eq to ~a" x a)
;; This test passes because B toplevel form is compiled after the
;; function FOO. Included here for completness.
(is (eq x b) "~a is not eq to ~a" x b) (is (eq x b) "~a is not eq to ~a" x b)
(is (eq a b) "~a is not eq to ~a" a b))) (is (eq a b) "~a is not eq to ~a" a b)))