* [PATCH 1/2] tests: Add new compile-file tests.
[not found] <878r7akwce.fsf@gmail.com>
@ 2023-11-10 3:32 ` Maxim Cournoyer
2023-11-10 3:32 ` [PATCH 2/2] ice-9: Fix 'include' when used in compilation contexts Maxim Cournoyer
0 siblings, 1 reply; 2+ messages in thread
From: Maxim Cournoyer @ 2023-11-10 3:32 UTC (permalink / raw)
To: guile-devel; +Cc: Maxim Cournoyer
Add a test for bug #66046.
To run just the compiler tests:
./meta/guile -L test-suite -L . test-suite/tests/compiler.test
* test-suite/tests/compiler.test (with-temporary-directory): New syntax.
(delete-file-recursively): New procedure.
("compile-file: relative include works")
("compile-file: relative include works with load path
canonicalization"): New tests.
---
test-suite/tests/compiler.test | 75 +++++++++++++++++++++++++++++++++-
1 file changed, 74 insertions(+), 1 deletion(-)
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index a018e0c41..2026d5ff3 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*-
-;;;; Copyright (C) 2008-2014, 2018, 2021-2022 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008-2014, 2018, 2021-2023 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,6 +18,7 @@
(define-module (tests compiler)
#:use-module (test-suite lib)
#:use-module (test-suite guile-test)
+ #:use-module (ice-9 ftw)
#:use-module (system base compile)
#:use-module ((language tree-il)
#:select (tree-il-src call-args))
@@ -27,6 +28,39 @@
(define read-and-compile
(@@ (system base compile) read-and-compile))
+;;; Based on 'with-directory-excursion', from (guix build utils).
+(define-syntax-rule (with-temporary-directory body ...)
+ "Run BODY with DIR as the process's current directory."
+ (let ((init (getcwd))
+ (dir (mkdtemp "tempdir.XXXXXX")))
+ (dynamic-wind
+ (lambda ()
+ (chdir dir))
+ (lambda ()
+ body ...)
+ (lambda ()
+ (chdir init)
+ (delete-file-recursively dir)))))
+
+;;; XXX: Adapted from (guix build utils).
+(define* (delete-file-recursively dir)
+ "Delete DIR recursively, like `rm -rf', without following symlinks."
+ (file-system-fold (const #t) ;enter
+ (lambda (file stat result) ; leaf
+ (delete-file file))
+ (const #t) ; down
+ (lambda (dir stat result) ; up
+ (rmdir dir))
+ (const #t) ; skip
+ (lambda (file stat errno result)
+ (format (current-error-port)
+ "warning: failed to delete ~a: ~a~%"
+ file (strerror errno)))
+ #t
+ dir
+
+ ;; Don't follow symlinks.
+ lstat))
\f
(with-test-prefix "basic"
@@ -434,3 +468,42 @@
(set! proc ((load-thunk-from-memory bytecode)))
(procedure? proc)))
(pass-if-equal "proc executes" 42 (proc))))
+
+(with-test-prefix "compile-file"
+ ;; Setup test library sources in a temporary directory.
+ (let ((top-sexp '(define-library (hello)
+ (import (scheme base)
+ (scheme write))
+ (export hello)
+ (include "hello/hello-impl.scm")))
+ (included-sexp '(define (hello)
+ (display "hello!\n"))))
+ (with-temporary-directory
+ (mkdir "module")
+ (call-with-output-file "module/hello.scm"
+ (lambda (port)
+ (write top-sexp port)))
+ (mkdir "module/hello")
+ (call-with-output-file "module/hello/hello-impl.scm"
+ (lambda (port)
+ (write included-sexp port)))
+ (mkdir "build")
+ (chdir "build")
+
+ (pass-if "relative include works"
+ (compile-file "../module/hello.scm" #:output-file "hello.go")
+ #t)
+
+ ;; This used to fail, because compile-file's #:canonicalization
+ ;; defaults to 'relative, which caused 'scm_relativize_path' to
+ ;; strip the prefix not in the load path, to avoid baking an
+ ;; invalid source file reference in the byte compiled output file
+ ;; (see: https://bugs.gnu.org/66046). This was fixed by having a
+ ;; 'compilation-source-file' fluid that preserves the file name
+ ;; passed to 'compile-file', used by 'include' instead of the file
+ ;; name of the port.
+ (pass-if "relative include works with load path canonicalization"
+ (begin
+ (add-to-load-path (string-append (getcwd) "/../module"))
+ (compile-file "../module/hello.scm" #:output-file "hello.go")
+ #t)))))
base-commit: 75cd95060fb1ea7586f0e4b9081694c6d61f1d3b
--
2.41.0
^ permalink raw reply related [flat|nested] 2+ messages in thread
* [PATCH 2/2] ice-9: Fix 'include' when used in compilation contexts.
2023-11-10 3:32 ` [PATCH 1/2] tests: Add new compile-file tests Maxim Cournoyer
@ 2023-11-10 3:32 ` Maxim Cournoyer
0 siblings, 0 replies; 2+ messages in thread
From: Maxim Cournoyer @ 2023-11-10 3:32 UTC (permalink / raw)
To: guile-devel; +Cc: Maxim Cournoyer
Fix bug #66046.
Introduce a 'compilation-source-file-name' fluid that captures the
pre-canonicalized file name used when compiling a file, before it gets
modified in fport_canonicalize_filename. That reference that can then
used directly by 'include', avoiding problems.
* module/ice-9/boot-9.scm (compilation-source-file-name): New fluid.
(compile-file): Set it to the value of FILE.
(compile-and-load): Likewise.
* module/ice-9/psyntax.scm (call-with-include-port): Use it.
---
module/ice-9/boot-9.scm | 6 ++++++
module/ice-9/psyntax.scm | 13 +++++++++----
module/system/base/compile.scm | 6 ++++--
3 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a5f2eea9b..7f2a02007 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -395,6 +395,12 @@ If returning early, return the return value of F."
;; expanded macros, to dispatch an input against a set of patterns.
(define $sc-dispatch #f)
+;;; This fluid captures the original compiled source file name, before
+;;; it gets potentially stripped by the file ports canonicalization. It
+;;; is used with 'include' to locate the true source, which is necessary
+;;; when using relative paths during compilation, for example.
+(define compilation-source-file-name (make-fluid #f))
+
;; Load it up!
(primitive-load-path "ice-9/psyntax-pp")
;; The binding for `macroexpand' has now been overridden, making psyntax the
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7811f7118..ccdd15fca 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -3260,15 +3260,20 @@
(let ((syntax-dirname (lambda (stx)
(define src (syntax-source stx))
(define filename (and src (assq-ref src 'filename)))
- (and (string? filename)
- (dirname filename)))))
+ (define source-file-name
+ (fluid-ref compilation-source-file-name))
+ (or (and source-file-name
+ (dirname source-file-name))
+ (and (string? filename)
+ (dirname filename))))))
(lambda* (filename proc #:key (dirname (syntax-dirname filename)))
"Like @code{call-with-input-file}, except relative paths are
-searched relative to the @var{dirname} instead of the current working
+searched relative to @var{dirname} instead of the current working
directory. Also, @var{filename} can be a syntax object; in that case,
and if @var{dirname} is not specified, the @code{syntax-source} of
@var{filename} is used to obtain a base directory for relative file
-names."
+names. As a special case, when the @var{compilation-source-file-name}
+fluid is set, its value overrides the @var{dirname} argument provided."
(let* ((filename (syntax->datum filename))
(p (open-input-file
(cond ((absolute-file-name? filename)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index a33d012bd..7b2670c21 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -174,7 +174,8 @@
(opts '())
(canonicalization 'relative))
(validate-options opts)
- (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (with-fluids ((%file-port-name-canonicalization canonicalization)
+ (compilation-source-file-name file))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
file)))
@@ -202,7 +203,8 @@
(opts '())
(canonicalization 'relative))
(validate-options opts)
- (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (with-fluids ((%file-port-name-canonicalization canonicalization)
+ (compilation-source-file-name file))
(read-and-compile (open-input-file file)
#:from from #:to to #:opts opts
#:optimization-level optimization-level
--
2.41.0
^ permalink raw reply related [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-11-10 3:32 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
[not found] <878r7akwce.fsf@gmail.com>
2023-11-10 3:32 ` [PATCH 1/2] tests: Add new compile-file tests Maxim Cournoyer
2023-11-10 3:32 ` [PATCH 2/2] ice-9: Fix 'include' when used in compilation contexts Maxim Cournoyer
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).