Commit ba31f587 authored by Marius Gerbershagen's avatar Marius Gerbershagen
Browse files

Merge branch 'fix-620' into develop

parents 74e366c2 ecb4ed10
......@@ -394,16 +394,15 @@
(let* ((*lcl* *lcl*)
(lcl (next-lcl))
(sym-loc (make-lcl-var))
(val-loc (make-lcl-var))
(*unwind-exit* (cons lcl *unwind-exit*)))
(val-loc (make-lcl-var)))
(wt-nl-open-brace)
(wt-nl "cl_object " sym-loc ", " val-loc "; cl_index " lcl ";")
(let ((*destination* sym-loc)) (c2expr* symbols))
(let ((*destination* val-loc)) (c2expr* values))
(wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");")
(c2expr body)
(wt-nl-close-brace)
))
(let ((*unwind-exit* (cons lcl *unwind-exit*)))
(wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");")
(c2expr body)
(wt-nl-close-brace))))
(defun c1psetq (old-args &aux (args nil) (use-psetf nil))
;; A first pass ensures that none of the assigned locations is
......
......@@ -1943,3 +1943,27 @@
(code `(defmethod test-method ()
,test-obj)))
(finishes (eval code)))))
;;; Date 2021-01-02
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/620
;;; Description
;;;
;;; RETURN inside the symbol or value arguments for PROGV leads to
;;; a segfault
(ext:with-clean-symbols (*s*)
(test cmp.0083.progv-return
(proclaim '(special *s*))
(is (eql 0 (funcall (compile nil
'(lambda ()
(block nil
(progv (list (return 0)) (list 1))))))))
(is (eql 0 (funcall (compile nil
'(lambda ()
(block nil
(progv '(*s*) (list (return 0)))))))))
(is (not (boundp '*s*)))
(is (eql 1 (funcall (compile nil
'(lambda ()
(block nil
(progv '(*s*) (list 0) (return 1) *s*)))))))
(is (not (boundp '*s*)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment