bug#66046: Relative includes in R7RS define-library seem broken
Maxim Cournoyer <[email protected]>
| Newsgroups | gmane.lisp.guile.bugs |
|---|---|
| Message-ID | <[email protected]> |
Hello,
Here's a new test that reproduces the issue:
I run it like:
--8<---------------cut here---------------start------------->8---
./meta/guile -L test-suite -L . test-suite/tests/compiler.test
--8<---------------cut here---------------end--------------->8---
And I see:
--8<---------------cut here---------------start------------->8---
ERROR: compile-file: relative include works with load path canonicalization - arguments: ((system-error "open-file" "~A: ~S" ("Aucun fichier ou dossier de ce type" "./hello/hello-impl.scm") (2)))
--8<---------------cut here---------------end--------------->8---
That's the include directive failing because scm_i_relativize_path
caused the path to be stripped from "../module/hello.scm" to
"hello.scm"; then include, through its call-with-include-port helper,
calls (dirname "hello.scm"), which produces ".".
Finally, the same helper calls (in-vicinity "." "hello/hello-impl.scm"),
which produces the unresolvable "./hello/hello-impl.scm" file name seen
in the error above.
--
Thanks,
Maxim
(unnamed)
(text/x-patch, 3.1 KB)
1 file changed, 65 insertions(+)
test-suite/tests/compiler.test | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
modified test-suite/tests/compiler.test
@@ -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))
(with-test-prefix "basic"
@@ -434,3 +468,34 @@
(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)
+
+ (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)))))