Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ecl
ecl
Commits
ba31f587
Commit
ba31f587
authored
Jan 16, 2021
by
Marius Gerbershagen
Browse files
Merge branch 'fix-620' into develop
parents
74e366c2
ecb4ed10
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/cmp/cmpvar.lsp
View file @
ba31f587
...
...
@@ -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
...
...
src/tests/normal-tests/compiler.lsp
View file @
ba31f587
...
...
@@ -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*
)))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment