diff --git a/ChangeLog b/ChangeLog index 262ed64c5..b3e3a061f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-07-25 Ludovic Courtès + + * NEWS: Mention bug fix for "(set! 'x #f)". + 2007-07-18 Ludovic Courtès * NEWS: Mention SRFI-37. diff --git a/NEWS b/NEWS index 277203e94..13f6f9f05 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,10 @@ Changes in 1.8.3 (since 1.8.2) ** `(srfi srfi-37)' +* Bugs fixed + +** Expressions like "(set! 'x #t)" no longer yield a crash + Changes in 1.8.2 (since 1.8.1): diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4ac245af4..b83b9d50d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2007-07-25 Ludovic Courtès + + * eval.c (macroexp): When `scm_ilength (res) <= 0', return + immediately. This used to produce a circular memoized + expression, e.g., for `(set (quote x) #t)'. + 2007-07-15 Ludovic Courtès * script.c (scm_compile_shell_switches): Updated copyright year. diff --git a/libguile/eval.c b/libguile/eval.c index 08ef53727..badd1edb1 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -878,26 +878,29 @@ macroexp (SCM x, SCM env) SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */ res = scm_call_2 (SCM_MACRO_CODE (proc), x, env); - + if (scm_ilength (res) <= 0) - res = scm_list_2 (SCM_IM_BEGIN, res); + /* Result of expansion is not a list. */ + return (scm_list_2 (SCM_IM_BEGIN, res)); + else + { + /* njrev: Several queries here: (1) I don't see how it can be + correct that the SCM_SETCAR 2 lines below this comment needs + protection, but the SCM_SETCAR 6 lines above does not, so + something here is probably wrong. (2) macroexp() is now only + used in one place - scm_m_generalized_set_x - whereas all other + macro expansion happens through expand_user_macros. Therefore + (2.1) perhaps macroexp() could be eliminated completely now? + (2.2) Does expand_user_macros need any critical section + protection? */ - /* njrev: Several queries here: (1) I don't see how it can be - correct that the SCM_SETCAR 2 lines below this comment needs - protection, but the SCM_SETCAR 6 lines above does not, so - something here is probably wrong. (2) macroexp() is now only - used in one place - scm_m_generalized_set_x - whereas all other - macro expansion happens through expand_user_macros. Therefore - (2.1) perhaps macroexp() could be eliminated completely now? - (2.2) Does expand_user_macros need any critical section - protection? */ + SCM_CRITICAL_SECTION_START; + SCM_SETCAR (x, SCM_CAR (res)); + SCM_SETCDR (x, SCM_CDR (res)); + SCM_CRITICAL_SECTION_END; - SCM_CRITICAL_SECTION_START; - SCM_SETCAR (x, SCM_CAR (res)); - SCM_SETCDR (x, SCM_CDR (res)); - SCM_CRITICAL_SECTION_END; - - goto macro_tail; + goto macro_tail; + } } /* Start of the memoizers for the standard R5RS builtin macros. */ diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index dc56898cc..43b32890a 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,10 @@ +2007-07-25 Ludovic Courtès + + * tests/srfi-17.test (%some-variable): New. + (set!)[target uses macro]: New test prefix. The + "(set! (@@ ...) 1)" test is in accordance with Marius Vollmer's + change in `libguile' dated 2003-11-17. + 2007-07-18 Stephen Compall * tests/syntax.test: Add SRFI-61 `cond' tests. diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test index 0a0b42541..fbacb15a3 100644 --- a/test-suite/tests/srfi-17.test +++ b/test-suite/tests/srfi-17.test @@ -48,6 +48,8 @@ ;; set! ;; +(define %some-variable #f) + (with-test-prefix "set!" (with-test-prefix "target is not procedure with setter" @@ -58,7 +60,20 @@ (pass-if-exception "(set! '#f 1)" exception:bad-variable - (eval '(set! '#f 1) (interaction-environment))))) + (eval '(set! '#f 1) (interaction-environment)))) + + (with-test-prefix "target uses macro" + + (pass-if "(set! (@@ ...) 1)" + (eval '(set! (@@ (test-suite test-srfi-17) %some-variable) 1) + (interaction-environment)) + (equal? %some-variable 1)) + + ;; The `(quote x)' below used to be memoized as an infinite list before + ;; Guile 1.8.3. + (pass-if-exception "(set! 'x 1)" + exception:bad-variable + (eval '(set! 'x 1) (interaction-environment))))) ;; ;; setter