~ chicken-core (chicken-5) 50470491e530257e18610d7688ae427248d779ec
commit 50470491e530257e18610d7688ae427248d779ec
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 4 12:12:48 2024 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Jun 17 08:07:55 2024 +0200
Ensure current source filename is set correctly
##sys#current-source-filename must be set during read-time (to
update line-info) and during expansion time (so include-relative
works). But body-canonicalization still requires the old context or included
let bodies will incorrectly refer to the new one.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/core.scm b/core.scm
index 2e2fa3ed..0a9b301e 100644
--- a/core.scm
+++ b/core.scm
@@ -989,17 +989,18 @@
bs) ) ) ) )
((##core#include)
- (##sys#include-forms-from-file
- (cadr x)
- (caddr x)
- (lambda (forms)
- (walk (if (pair? (cdddr x)) ; body?
- (canonicalize-body/ln
- ln
- (append forms (cadddr x))
- compiler-syntax-enabled)
- `(##core#begin ,@forms))
- e dest ldest h ln tl?))))
+ (##sys#include-forms-from-file
+ (cadr x)
+ (caddr x)
+ (lambda (forms path)
+ (let ((code (if (pair? (cdddr x)) ; body?
+ (canonicalize-body/ln
+ ln
+ (append forms (cadddr x))
+ compiler-syntax-enabled)
+ `(##core#begin ,@forms))))
+ (fluid-let ((##sys#current-source-filename path))
+ (walk code e dest ldest h ln tl?))))))
((##core#let-module-alias)
(##sys#with-module-aliases
diff --git a/eval.scm b/eval.scm
index 92244301..b8e59ae5 100644
--- a/eval.scm
+++ b/eval.scm
@@ -523,7 +523,7 @@
(compile '(##core#undefined) e #f tf cntr #f))
((##core#let-compiler-syntax)
- (compile
+ (compile
(##sys#canonicalize-body (cddr x) (##sys#current-environment) #f)
e #f tf cntr #f))
@@ -531,14 +531,14 @@
(##sys#include-forms-from-file
(cadr x)
(caddr x)
- (lambda (forms)
- (compile
- (if (pair? (cdddr x)) ; body?
- (##sys#canonicalize-body
- (append forms (cadddr x))
- (##sys#current-environment))
- `(##core#begin ,@forms))
- e #f tf cntr tl?))))
+ (lambda (forms path)
+ (let ((code (if (pair? (cdddr x)) ; body?
+ (##sys#canonicalize-body
+ (append forms (cadddr x))
+ (##sys#current-environment))
+ `(##core#begin ,@forms))))
+ (fluid-let ((##sys#current-source-filename path))
+ (compile code e #f tf cntr tl?))))))
((##core#let-module-alias)
(##sys#with-module-aliases
@@ -1184,7 +1184,8 @@
(do ((x (read-with-source-info in) (read-with-source-info in))
(xs '() (cons x xs)))
((eof-object? x)
- (reverse xs)))))))))))
+ (reverse xs))))
+ path)))))))
;;; Extensions:
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 185db284..43cd2ada 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -494,6 +494,15 @@ echo '(include-relative "b/ok.scm")' > a/include.scm
$compile -analyze-only a/include.scm
echo '(include-relative "b/ok.scm")' > a/b/include.scm
$compile -analyze-only a/b/include.scm -include-path a
+echo > a/b/other.scm
+# make sure first include doesn't change state for second:
+echo '(include-relative "b/ok.scm") (include-relative "b/other.scm")' > a/include.scm
+$compile -analyze-only a/include.scm
+echo '(include-relative "ok.scm")' > a/b/other.scm
+echo '(include-relative "b/other.scm")' > a/include.scm
+$compile -analyze-only a/include.scm
+echo '(include-relative "b/other.scm") (let () (include-relative "b/ok.scm") (include-relative "b/ok.scm"))' > a/include.scm
+$compile -analyze-only a/include.scm
rm -r a
echo "======================================== executable tests ..."
Trap