* [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).