~ chicken-core (chicken-5) 2029fcae882dbbf2552b3ae21a606ad0873da398
commit 2029fcae882dbbf2552b3ae21a606ad0873da398 Author: Peter Bex <peter@more-magic.net> AuthorDate: Sat Aug 4 11:29:52 2018 +0200 Commit: Evan Hanson <evhan@foldling.org> CommitDate: Sun Aug 5 11:21:22 2018 +1200 Ignore macros when looking up symbol aliases This makes it so that we don't unintentionally end up using macro definitions as identifiers. Fixes #1493, found by Megane. Signed-off-by: Evan Hanson <evhan@foldling.org> diff --git a/core.scm b/core.scm index 2bbed0b2..3ecdd817 100644 --- a/core.scm +++ b/core.scm @@ -517,7 +517,7 @@ (define (lookup id) (cond ((find-id id (##sys#current-environment))) - ((##sys#get id '##core#macro-alias)) + ((##sys#get id '##core#macro-alias) symbol? => values) (else id))) (define (macro-alias var) diff --git a/eval.scm b/eval.scm index e31fbfce..c34622f7 100644 --- a/eval.scm +++ b/eval.scm @@ -92,7 +92,7 @@ (define (rename var) (cond ((find-id var (##sys#current-environment))) - ((##sys#get var '##core#macro-alias)) + ((##sys#get var '##core#macro-alias) symbol? => values) (else var))) (define (lookup var0 e) diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index 38ae5978..663aa40e 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -1285,3 +1285,30 @@ other-eval (t 1 (letrec* ((foo 1) (bar foo)) bar)) + + +;; This would crash in nasty ways (see #1493, reported by megane) +(module self-redefinition (foo) + (import scheme (chicken base)) + + (define-syntax foo + (ir-macro-transformer + (lambda (e i c) + (apply + (lambda (name) + `(begin + (define-syntax ,(strip-syntax name) + (syntax-rules () ((_ . _) 'new))) + 'old)) + (cdr e)))))) + +(import (rename self-redefinition (foo imported-foo))) +(import (rename self-redefinition (foo reimported-foo))) + +(t 'old (imported-foo imported-foo)) +(t 'new (imported-foo imported-foo)) + +;; Like any normal redefinition, the underlying exported identifier +;; changes, and any other imports are simply aliases. +;;(t 'old (reimported-foo reimported-foo)) +(t 'new (reimported-foo reimported-foo))Trap