From 9735057bc3700b9b4df24e3be18263e159c7bdec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 22:35:37 +0200 Subject: [PATCH 1/6] stacks: don't call si_set_finalizer si_set_finalizer is CL-world function and returns 0 values. That means in particular, that env->nvalues is changed. In this situation, when new binding was introduced, we could lose our nvalues, what lead to invalid multiple-value-bind (next commit will contain a regression test). We use unprotected version. If interrupts cause problems with it, we may need to wrap it in disable_interrupts. Threading code uses ecl_set_finalizer_unprotected without such wrapping though, so I believe that should be safe. Fixes #233. --- src/c/stacks.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/stacks.d b/src/c/stacks.d index e74e7efbd..ce3e74a03 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -274,7 +274,7 @@ ecl_new_binding_index(cl_env_ptr env, cl_object symbol) symbol->symbol.binding = new_index; symbol->symbol.dynamic |= 1; } - si_set_finalizer(symbol, ECL_T); + ecl_set_finalizer_unprotected(symbol, ECL_T); return new_index; } From aeaa3017bc3e90103dc6a47195a7507c7c0beb05 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 23:03:29 +0200 Subject: [PATCH 2/6] tests: fix multiple evaluation of forms --- src/tests/ecl-tests.lisp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index cf6835517..940b95499 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -52,16 +52,20 @@ (frob specs body))) (defmacro is-true (form) - `(is (eql ,form t) "Expected T, but got ~s" ,form)) + (ext:once-only (form) + `(is (eql ,form t) "Expected T, but got ~s" ,form))) (defmacro is-false (form) - `(is (null ,form) "Expected NIL, but got ~s" ,form)) + (ext:once-only (form) + `(is (null ,form) "Expected NIL, but got ~s" ,form))) (defmacro is-equal (what form) - `(is (equal ,what ,form) "EQUAL: ~s to ~s" ,form ,what)) + (ext:once-only (what form) + `(is (equal ,what ,form) "EQUAL: ~s to ~s" ,what ,form))) (defmacro is-eql (what form) - `(is (eql ,what ,form) "EQL: ~s to ~s" ,what ,form)) + (ext:once-only (what form) + `(is (eql ,what ,form) "EQL: ~s to ~a" ,what ,form))) (defmacro pass (form &rest args) (declare (ignore form args)) From cc332a6c3f887850e8cf4c3f3a6b7d1c21842817 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 23:03:43 +0200 Subject: [PATCH 3/6] tests: with-compiler: add todo --- src/tests/ecl-tests.lisp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index 940b95499..d84458308 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -123,6 +123,10 @@ as a second value." (*compile-verbose* t) (*compile-print* t)) (setf compiled-file (compile-file ,filename ,@compiler-args)))))) + ;; todo: add delete-files flag + ;; (when delete-files + ;; (delete-file filename) + ;; (delete-file compiled-file)) (values compiled-file output)))) (defmacro with-temporary-file ((var string &rest args) &body body) From c999b56ab50d01d90345cf047197ca8cd5390c5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 23:04:25 +0200 Subject: [PATCH 4/6] tests: add regression test for #233. --- src/tests/normal-tests/mixed.lsp | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index f2ddf9a73..54a589913 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -225,3 +225,30 @@ (go :next) (print 'skip) :next)))) + + +;;; Data: 2017-07-02 +;;; Description: +;;; +;;; Function `ecl_new_binding_index' called `si_set_finalizer', +;;; which resetted `env->nvalues' leading to invalid binding in mvb +;;; during the first function run. +;;; +;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/233 +(test mix.0015.mvb + (with-compiler ("aux-cl-0003.lsp" :load t) + `(progn + (defvar mix.0015.v1 'booya) + (defun mix.0015.fun () + (let ((share_t)) + (multiple-value-bind (mix.0015.v1 woops) + (case share_t + ((nil) + (values 1 2))) + woops))))) + (ignore-errors + (delete-file "aux-cl-0003.lsp") + (delete-file "aux-cl-0003.fas") + (delete-file "aux-cl-0003.fasc")) + (is-eql 2 (mix.0015.fun))) + From b1462dcb65a30c5b9a16bff4c0a0161c62e18996 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 23:05:21 +0200 Subject: [PATCH 5/6] cosmetic: remove extra newline --- src/tests/normal-tests/mixed.lsp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index 54a589913..18e49f770 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -251,4 +251,3 @@ (delete-file "aux-cl-0003.fas") (delete-file "aux-cl-0003.fasc")) (is-eql 2 (mix.0015.fun))) - From 243646104b52a990feccd812bcaca87e6d53f5ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 2 Jul 2017 23:12:12 +0200 Subject: [PATCH 6/6] cosmetic: remove unused macro --- src/tests/ecl-tests.lisp | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index d84458308..97223ff82 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -29,28 +29,6 @@ ffi mop run-program)) -;;; Some syntactic sugar for 2am -(defmacro once-only (specs &body body) - "Once-Only ({(Var Value-Expression)}*) Form* - - Create a Let* which evaluates each Value-Expression, binding a - temporary variable to the result, and wrapping the Let* around the - result of the evaluation of Body. Within the body, each Var is - bound to the corresponding temporary variable." - (labels ((frob (specs body) - (if (null specs) - `(progn ,@body) - (let ((spec (first specs))) - (when (/= (length spec) 2) - (error "Malformed Once-Only binding spec: ~S." spec)) - (let ((name (first spec)) - (exp-temp (gensym))) - `(let ((,exp-temp ,(second spec)) - (,name (gensym "OO-"))) - `(let ((,,name ,,exp-temp)) - ,,(frob (rest specs) body)))))))) - (frob specs body))) - (defmacro is-true (form) (ext:once-only (form) `(is (eql ,form t) "Expected T, but got ~s" ,form)))