On Sun, Jul 22, 2018 at 05:35:27PM +0200, Peter Bex wrote: > Hi all, > > I was trying to figure out why memory-mapped-files isn't working on > Windows so I started out with "chicken-install -retrieve memory-mapped-files", > but this failed because xcopy is invoked with a source path which contains > forward slashes. The fix is to call "slashify" on these paths in > copy-egg-sources, but I noticed this problem is a lot more prevalent, in > egg-compile.scm there are lots of missing calls to slashify and to quotearg, > as well.
I noticed that there were a few I missed; the .inline, .types and static extension files could not be copied on Windows either (the generated install script was bad). Here's an updated version of my earlier patch. Cheers, Peter
From d79301dc35e3ca57323052a395b10f58c0e390c8 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 22 Jul 2018 16:58:46 +0200
Subject: [PATCH] Quote and slashify destination directories too
For example, xcopy will try to interpret forward slashes as command
line parameters, resulting in problems when retrieving eggs and
copying a directory.
---
chicken-install.scm | 4 +++-
egg-compile.scm | 54 +++++++++++++++++++++++++++++++++++------------------
2 files changed, 39 insertions(+), 19 deletions(-)
diff --git a/chicken-install.scm b/chicken-install.scm
index eb484f28..74fb24a4 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -501,7 +501,9 @@
(let ((cmd (quote-all
(string-append
(copy-directory-command platform)
- " " (quotearg (make-pathname from "*")) " " (quotearg to))
+ " " (quotearg (slashify (make-pathname from "*")
+ platform))
+ " " (quotearg (slashify to platform)))
platform)))
(d "~a~%" cmd)
(system cmd)))
diff --git a/egg-compile.scm b/egg-compile.scm
index 364af316..7924b2fa 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -644,12 +644,14 @@
(mkdir (mkdir-command platform))
(ext (object-extension platform))
(sname (prefix srcdir name))
- (out (quotearg (target-file (conc sname ".static" ext)
- mode)))
- (outlnk (quotearg (conc sname +link-file-extension+)))
+ (out (quotearg (slashify (target-file (conc sname ".static" ext)
+ mode) platform)))
+ (outlnk (quotearg (slashify (conc sname +link-file-extension+)
+ platform)))
(dest (destination-repository mode))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(print cmd " " out " " ddir
(quotearg (slashify (conc dest "/"
@@ -670,10 +672,12 @@
(dcmd (remove-file-command platform))
(mkdir (mkdir-command platform))
(sname (prefix srcdir name))
- (out (quotearg (target-file (conc sname ext) mode)))
+ (out (quotearg (slashify (target-file (conc sname ext) mode)
+ platform)))
(dest (destination-repository mode))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform)))
(destf (quotearg (slashify (conc dest "/" output-file ext)
platform))))
(print "\n" mkdir " " ddir dfile)
@@ -693,10 +697,13 @@
(let* ((cmd (install-file-command platform))
(mkdir (mkdir-command platform))
(sname (prefix srcdir name))
- (out (quotearg (target-file (conc sname ".import.scm") mode)))
+ (out (quotearg (slashify (target-file (conc sname ".import.scm")
+ mode)
+ platform)))
(dest (destination-repository mode))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(print cmd " " out " " ddir
(quotearg (slashify (conc dest "/" name ".import.scm")
@@ -707,10 +714,13 @@
srcdir platform)
(let* ((cmd (install-file-command platform))
(mkdir (mkdir-command platform))
- (out (quotearg (prefix srcdir (conc types-file ".types"))))
+ (out (quotearg (slashify (prefix srcdir
+ (conc types-file ".types"))
+ platform)))
(dest (destination-repository mode))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(print cmd " " out " " ddir
(quotearg (slashify (conc dest "/" types-file ".types")
@@ -721,10 +731,13 @@
srcdir platform)
(let* ((cmd (install-file-command platform))
(mkdir (mkdir-command platform))
- (out (quotearg (prefix srcdir (conc inline-file ".inline"))))
+ (out (quotearg (slashify (prefix srcdir
+ (conc inline-file ".inline"))
+ platform)))
(dest (destination-repository mode))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(print cmd " " out " " ddir
(quotearg (slashify (conc dest "/" inline-file ".inline")
@@ -737,12 +750,14 @@
(mkdir (mkdir-command platform))
(ext (executable-extension platform))
(sname (prefix srcdir name))
- (out (quotearg (target-file (conc sname ext) mode)))
+ (out (quotearg (slashify (target-file (conc sname ext) mode)
+ platform)))
(dest (if (eq? mode 'target)
default-bindir
(override-prefix "/bin" host-bindir)))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform)))
(destf (quotearg (slashify (conc dest "/" output-file ext)
platform))))
(print "\n" mkdir " " ddir dfile)
@@ -761,12 +776,13 @@
default-sharedir
(override-prefix "/share" host-sharedir))))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(let-values (((ds fs) (partition directory? sfiles)))
(for-each
(lambda (d)
- (print dcmd " " (quotearg d) " " ddir dfile)
+ (print dcmd " " (quotearg (slashify d platform)) " " ddir dfile)
(print-end-command platform))
ds)
(when (pair? fs)
@@ -781,7 +797,8 @@
default-incdir
(override-prefix "/include" host-incdir))))
(dfile (quotearg (slashify dest platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(print "\n" mkdir " " ddir dfile)
(print cmd (arglist (map (cut prefix srcdir <>) files)) " " ddir dfile)
(print-end-command platform)))
@@ -866,7 +883,8 @@ EOF
(qdir (quotearg (slashify dir platform)))
(dest (quotearg (slashify (make-pathname dir name +egg-info-extension+)
platform)))
- (ddir (shell-variable "DESTDIR" platform)))
+ (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
+ platform))))
(case platform
((unix)
(printf #<<EOF
--
2.11.0
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
