Add patch from drscheme svn to fix weird problems with DESTDIR installs. Fixes bug #146748.

Package-Manager: portage-2.1.2_pre2-r9

4 files changed, 444 insertions, 10 deletions

diff --git a/dev-scheme/drscheme/ChangeLog b/dev-scheme/drscheme/ChangeLog
index 3ee03c2e53bf..dc90fe6d0631 100644
--- a/dev-scheme/drscheme/ChangeLog
+++ b/dev-scheme/drscheme/ChangeLog
@@ -1,6 +1,11 @@
 # ChangeLog for dev-scheme/drscheme
 # Copyright 2002-2006 Gentoo Foundation; Distributed under the GPL v2
-# $Header: /var/cvsroot/gentoo-x86/dev-scheme/drscheme/ChangeLog,v 1.30 2006/09/07 21:34:02 chutzpah Exp $
+# $Header: /var/cvsroot/gentoo-x86/dev-scheme/drscheme/ChangeLog,v 1.31 2006/10/13 14:39:32 chutzpah Exp $
+
+  13 Oct 2006; Patrick McLean <chutzpah@gentoo.org>
+  +files/drscheme-352-destdir.patch, drscheme-352.ebuild:
+  Add patch from drscheme svn to fix weird problems with DESTDIR installs.
+  Fixes bug #146748.
 
   07 Sep 2006; Patrick McLean <chutzpah@gentoo.org> drscheme-352.ebuild:
   Add some processing of LDFLAGS to prevent compiliation errors if the user
diff --git a/dev-scheme/drscheme/Manifest b/dev-scheme/drscheme/Manifest
index efe9f1533ebd..6b8f2cefeeb4 100644
--- a/dev-scheme/drscheme/Manifest
+++ b/dev-scheme/drscheme/Manifest
@@ -10,20 +10,24 @@ AUX drscheme-350-fPIC.patch 2979 RMD160 9382e8fc9ad56cad49eda737b7bc3ee558db4b4c
 MD5 5c798441cb6814dd52eab276c9014884 files/drscheme-350-fPIC.patch 2979
 RMD160 9382e8fc9ad56cad49eda737b7bc3ee558db4b4c files/drscheme-350-fPIC.patch 2979
 SHA256 d020ff1cbc173525a68d52da05e8552787f4bb2ce555e88051997bcc865caff1 files/drscheme-350-fPIC.patch 2979
+AUX drscheme-352-destdir.patch 16696 RMD160 dffee12eb9170861c4f71699881f14cca9cdf2e1 SHA1 63aee8a3436dfb13cbc97c72b28aedf723882675 SHA256 2e26b0498b103b2559b411c0df7f6927b1ad310336732eb637031f51463062d0
+MD5 0524d01ca8ff2c86bd586bba88765106 files/drscheme-352-destdir.patch 16696
+RMD160 dffee12eb9170861c4f71699881f14cca9cdf2e1 files/drscheme-352-destdir.patch 16696
+SHA256 2e26b0498b103b2559b411c0df7f6927b1ad310336732eb637031f51463062d0 files/drscheme-352-destdir.patch 16696
 DIST plt-301-src-unix.tgz 12706538 RMD160 35a7a927bf24e7c5c331551ad72c32c9b7d4d742 SHA1 fe6824eaa0e45c6145c9130f3ae67a8544d0f8b5 SHA256 c914cd2f4ccf1ca706738ee9e11df75632a71cab2a9d70fb292b4ebad410dd52
 DIST plt-352-src-unix.tgz 13661695 RMD160 f7655e4f21cd54ddd6b9d6c29c056ef76e1b589b SHA1 ddf23b6ea87292b31ac4e351594fcc2cfdc175b7 SHA256 f221a21667c19d763e204310055804c6f6eab9349eccf9481afd5104edb8e45d
 EBUILD drscheme-301-r2.ebuild 2346 RMD160 7266de9376a23ce2f5ae9b11eaf13a973b8cc502 SHA1 381d5c58f78d6d748f75cb0bd3ab0ac1053ad4d3 SHA256 7fe613a456cb25f91a8c2fa1d1b5394023478bba83e500b2558acb75179cf52e
 MD5 2fa45c157897e563148f1d56dad6a6cf drscheme-301-r2.ebuild 2346
 RMD160 7266de9376a23ce2f5ae9b11eaf13a973b8cc502 drscheme-301-r2.ebuild 2346
 SHA256 7fe613a456cb25f91a8c2fa1d1b5394023478bba83e500b2558acb75179cf52e drscheme-301-r2.ebuild 2346
-EBUILD drscheme-352.ebuild 2211 RMD160 b4c20bc28ebd0f4650c97437c6e2eb1aad00524b SHA1 7f87038e2057f959bec25ddb1d684599ed2cf794 SHA256 12143bcfc0ba49f4bcdbea294503780bea6f682965625e82e62c7eb6779e2f05
-MD5 587db1b30036cf6ecadfc6c191d114e8 drscheme-352.ebuild 2211
-RMD160 b4c20bc28ebd0f4650c97437c6e2eb1aad00524b drscheme-352.ebuild 2211
-SHA256 12143bcfc0ba49f4bcdbea294503780bea6f682965625e82e62c7eb6779e2f05 drscheme-352.ebuild 2211
-MISC ChangeLog 6650 RMD160 268f08e38775ac9a2acbd81416923e8f0d34bc87 SHA1 1e8cdc39c8d453552134fa99e83d8c78d95563e2 SHA256 8dc200f3ece15fe6347bff072528ef6f41b196c028405e50f38c4744591ee86f
-MD5 9b5e93e3295d20d9a5943ed715284044 ChangeLog 6650
-RMD160 268f08e38775ac9a2acbd81416923e8f0d34bc87 ChangeLog 6650
-SHA256 8dc200f3ece15fe6347bff072528ef6f41b196c028405e50f38c4744591ee86f ChangeLog 6650
+EBUILD drscheme-352.ebuild 2252 RMD160 5e8cf1f9ffd6c800686010df8c6496eb381c7093 SHA1 76d7d478246d78525b43b99059afcb743af2d073 SHA256 47a73c8f5d948e45565f6222d63415cb811866f2ec856def253666cf1b29dc7d
+MD5 b75ad0ae3b5c362917867e8c54c272b8 drscheme-352.ebuild 2252
+RMD160 5e8cf1f9ffd6c800686010df8c6496eb381c7093 drscheme-352.ebuild 2252
+SHA256 47a73c8f5d948e45565f6222d63415cb811866f2ec856def253666cf1b29dc7d drscheme-352.ebuild 2252
+MISC ChangeLog 6857 RMD160 0914ee0d03fe4a52dabdd852fa7d597d59a1bad3 SHA1 893da54cef41c07d17dd49ee0454a2a1cd9eda20 SHA256 6feda124338dec1c53510e687317194022d10958956f8569188faca8c9539ee9
+MD5 511a2281c3a0d3d0056f4cf0dd3b6770 ChangeLog 6857
+RMD160 0914ee0d03fe4a52dabdd852fa7d597d59a1bad3 ChangeLog 6857
+SHA256 6feda124338dec1c53510e687317194022d10958956f8569188faca8c9539ee9 ChangeLog 6857
 MISC metadata.xml 694 RMD160 ab738064eeb10e5a01c1f2a9040da48b5f68d244 SHA1 32c314fc3597aa38f9724b26f05ae9494d8b3309 SHA256 b63c1d1ae1adc89c062f612f797abf9e0933fc67725d301558f27832bd8c875d
 MD5 274a7900f799811ad11e1a827bb4b23e metadata.xml 694
 RMD160 ab738064eeb10e5a01c1f2a9040da48b5f68d244 metadata.xml 694
diff --git a/dev-scheme/drscheme/drscheme-352.ebuild b/dev-scheme/drscheme/drscheme-352.ebuild
index d39a2617c60b..163fac5ea6d1 100644
--- a/dev-scheme/drscheme/drscheme-352.ebuild
+++ b/dev-scheme/drscheme/drscheme-352.ebuild
@@ -1,6 +1,6 @@
 # Copyright 1999-2006 Gentoo Foundation
 # Distributed under the terms of the GNU General Public License v2
-# $Header: /var/cvsroot/gentoo-x86/dev-scheme/drscheme/drscheme-352.ebuild,v 1.3 2006/09/07 21:34:02 chutzpah Exp $
+# $Header: /var/cvsroot/gentoo-x86/dev-scheme/drscheme/drscheme-352.ebuild,v 1.4 2006/10/13 14:39:32 chutzpah Exp $
 
 inherit eutils multilib
 
@@ -38,6 +38,7 @@ src_unpack() {
 	cd "${WORKDIR}/plt"
 
 	epatch "${FILESDIR}/${PN}-350-fPIC.patch"
+	epatch "${FILESDIR}/${P}-destdir.patch"
 
 	if ! use opengl ; then
 		# move aside the opengl-dependent stuff or install will fail
diff --git a/dev-scheme/drscheme/files/drscheme-352-destdir.patch b/dev-scheme/drscheme/files/drscheme-352-destdir.patch
new file mode 100644
index 000000000000..721fcc3f586c
--- /dev/null
+++ b/dev-scheme/drscheme/files/drscheme-352-destdir.patch
@@ -0,0 +1,424 @@
+Index: collects/setup/dirs.ss
+===================================================================
+--- collects/setup/dirs.ss	(revision 4476)
++++ collects/setup/dirs.ss	(revision 4477)
+@@ -1,42 +1,49 @@
+ (module dirs mzscheme
+   (require (prefix config: (lib "config.ss" "config"))
+-	   (lib "winutf16.ss" "compiler" "private")
+-	   (lib "mach-o.ss" "compiler" "private"))
++           (lib "winutf16.ss" "compiler" "private")
++           (lib "mach-o.ss" "compiler" "private"))
+ 
+   (provide (rename config:absolute-installation? absolute-installation?))
+ 
++  ;; path normalization is not really necessary by any existing code,
++  ;; but there might be applications that rely on these paths, so it's
++  ;; best to do some minor normalization.  This is similar to what
++  ;; "main-collects.ss" does.  Again, this makes mzscheme expand paths
++  ;; that begin with `~'.
++  (define (system-path* what)
++    (expand-path (simplify-path (find-system-path what) #f)))
++
+   ;; ----------------------------------------
+   ;;  "collects"
+ 
+   (define main-collects-dir
+     (delay
+-      (let ([d (find-system-path 'collects-dir)])
+-	(cond
+-	 [(complete-path? d) d]
+-	 [(absolute-path? d)
+-	  ;; This happens only under Windows; add a drive
+-	  ;;  specification to make the path complete
+-	  (let ([exec (path->complete-path 
+-		       (find-executable-path (find-system-path 'exec-file))
+-		       (find-system-path 'orig-dir))])
+-	    (let-values ([(base name dir?) (split-path exec)])
+-	      (path->complete-path d base)))]
+-	 [else
+-	  ;; Relative to executable...
+-	  (parameterize ([current-directory (find-system-path 'orig-dir)])
+-	    (let ([p (or (find-executable-path (find-system-path 'exec-file) d #t)
+-			 ;; If we get here, then we can't find the directory
+-			 #f)])
+-	      (and p
+-		   (simplify-path p))))]))))
++      (let ([d (system-path* 'collects-dir)])
++        (cond
++         [(complete-path? d) d]
++         [(absolute-path? d)
++          ;; This happens only under Windows; add a drive
++          ;;  specification to make the path complete
++          (let ([exec (path->complete-path
++                       (find-executable-path (system-path* 'exec-file))
++                       (system-path* 'orig-dir))])
++            (let-values ([(base name dir?) (split-path exec)])
++              (path->complete-path d base)))]
++         [else
++          ;; Relative to executable...
++          (parameterize ([current-directory (system-path* 'orig-dir)])
++            (let ([p (or (find-executable-path (system-path* 'exec-file) d #t)
++                         ;; If we get here, then we can't find the directory
++                         #f)])
++              (and p (simplify-path p))))]))))
+ 
+   (provide find-collects-dir
+-	   find-user-collects-dir
+-	   get-collects-search-dirs)
++           find-user-collects-dir
++           get-collects-search-dirs)
+   (define (find-collects-dir)
+     (force main-collects-dir))
+   (define user-collects-dir
+-    (delay (build-path (find-system-path 'addon-dir) (version) "collects")))
++    (delay (build-path (system-path* 'addon-dir) (version) "collects")))
+   (define (find-user-collects-dir)
+     (force user-collects-dir))
+   (define (get-collects-search-dirs)
+@@ -50,51 +57,47 @@
+   (define (combine-search l default)
+     ;; Replace #f in list with default path:
+     (if l
+-	(let loop ([l l])
+-	  (cond
+-	   [(null? l) null]
+-	   [(not (car l)) (append default (loop (cdr l)))]
+-	   [else (cons (car l) (loop (cdr l)))]))
+-	default))
++        (let loop ([l l])
++          (cond
++           [(null? l) null]
++           [(not (car l)) (append default (loop (cdr l)))]
++           [else (cons (car l) (loop (cdr l)))]))
++        default))
+   (define (cons-user u r)
+-    (if (use-user-specific-search-paths) 
+-	(cons u r)
+-	r))
++    (if (use-user-specific-search-paths) (cons u r) r))
+ 
+   (define-syntax define-finder
+     (syntax-rules ()
+       [(_ provide config:id id user-id config:search-id search-id default)
+        (begin
+-	 (define-finder provide config:id id user-id default)
+-	 (provide search-id)
+-	 (define (search-id)
+-	   (combine-search (force config:search-id)
+-			   (cons-user (user-id) (single (id))))))]
+-      [(_ provide config:id id user-id config:search-id search-id extra-search-dir default)
++         (define-finder provide config:id id user-id default)
++         (provide search-id)
++         (define (search-id)
++           (combine-search (force config:search-id)
++                           (cons-user (user-id) (single (id))))))]
++      [(_ provide config:id id user-id config:search-id search-id
++          extra-search-dir default)
+        (begin
+-	 (define-finder provide config:id id user-id default)
+-	 (provide search-id)
+-	 (define (search-id)
+-	   (combine-search (force config:search-id)
+-			   (extra (extra-search-dir) 
+-				  (cons-user (user-id) (single (id)))))))]
++         (define-finder provide config:id id user-id default)
++         (provide search-id)
++         (define (search-id)
++           (combine-search (force config:search-id)
++                           (extra (extra-search-dir)
++                                  (cons-user (user-id) (single (id)))))))]
+       [(_ provide config:id id user-id default)
+        (begin
+-	 (provide id user-id)
+-	 (define dir
+-	   (delay
+-	     (or (force config:id)
+-		 (let ([p (find-collects-dir)])
+-		   (and p
+-			(simplify-path (build-path p
+-						   'up
+-						   default)))))))
+-	 (define (id)
+-	   (force dir))
+-	 (define user-dir
+-	   (delay (build-path (find-system-path 'addon-dir) (version) default)))
+-	 (define (user-id)
+-	   (force user-dir)))]))
++         (provide id user-id)
++         (define dir
++           (delay
++             (or (force config:id)
++                 (let ([p (find-collects-dir)])
++                   (and p (simplify-path (build-path p 'up default)))))))
++         (define (id)
++           (force dir))
++         (define user-dir
++           (delay (build-path (system-path* 'addon-dir) (version) default)))
++         (define (user-id)
++           (force user-dir)))]))
+ 
+   (define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
+ 
+@@ -104,8 +107,8 @@
+   (define delayed-#f (delay #f))
+ 
+   (provide find-doc-dir
+-	   find-user-doc-dir
+-	   get-doc-search-dirs)
++           find-user-doc-dir
++           get-doc-search-dirs)
+   (define-finder no-provide
+     config:doc-dir
+     find-doc-dir
+@@ -116,9 +119,9 @@
+   ;; For now, include "doc" pseudo-collections in search path:
+   (define (get-doc-search-dirs)
+     (combine-search (force config:doc-search-dirs)
+-		    (append (get-new-doc-search-dirs)
+-			    (map (lambda (p) (build-path p "doc"))
+-				 (current-library-collection-paths)))))
++                    (append (get-new-doc-search-dirs)
++                            (map (lambda (p) (build-path p "doc"))
++                                 (current-library-collection-paths)))))
+ 
+   ;; ----------------------------------------
+   ;; "include"
+@@ -145,14 +148,14 @@
+   ;; ----------------------------------------
+   ;; Executables
+ 
+-  (define-finder provide 
++  (define-finder provide
+     config:bin-dir
+-    find-console-bin-dir 
++    find-console-bin-dir
+     find-user-console-bin-dir
+     (case (system-type)
+       [(windows) 'same]
+       [(macosx unix) "bin"]))
+-  
++
+   (define-finder provide
+     config:bin-dir
+     find-gui-bin-dir
+@@ -163,64 +166,66 @@
+ 
+   ;; ----------------------------------------
+   ;; DLLs
+-  
++
+   (provide find-dll-dir)
+   (define dll-dir
+-    (delay (case (system-type)
+-	     [(windows)
+-	      ;; Extract "lib" location from binary:
+-	      (let ([exe (parameterize ([current-directory (find-system-path 'orig-dir)])
+-			   (find-executable-path (find-system-path 'exec-file)))])
+-		(with-input-from-file exe
+-		  (lambda ()
+-		    (let ([m (regexp-match (byte-regexp 
+-					    (bytes-append
+-					     (bytes->utf-16-bytes #"dLl dIRECTORy:")
+-					     #"((?:..)*?)\0\0"))
+-					   (current-input-port))])
+-		      (unless m (error "cannot find \"dLl dIRECTORy\" tag in binary"))
+-		      (let-values ([(dir name dir?) (split-path exe)])
+-			(if (regexp-match #rx#"^<" (cadr m))
+-			    ;; no DLL dir in binary
+-			    #f
+-			    ;; resolve relative directory:
+-			    (let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))])
+-			      (path->complete-path p dir))))))))]
+-	     [(macosx)
+-	      (let ([exe (parameterize ([current-directory (find-system-path 'orig-dir)])
+-			   (let loop ([p (find-executable-path (find-system-path 'exec-file))])
+-			     (if (link-exists? p)
+-				 (loop (let-values ([(r) (resolve-path p)]
+-						    [(dir name dir?) (split-path p)])
+-					 (if (and (path? dir)
+-						  (relative-path? r))
+-					     (build-path dir r)
+-					     r)))
+-				 p)))])
+-		(let ([rel (get/set-dylib-path exe "PLT_M[rz]" #f)])
+-		  (if rel
+-		      (cond
+-		       [(regexp-match #rx#"^(@executable_path/)?(.*?)PLT_M(?:rEd|zScheme).framework" rel)
+-			=> (lambda (m)
+-			     (let ([b (caddr m)])
+-			       (if (and (not (cadr m))
+-					(bytes=? b #""))
+-				   #f ; no path in exe
+-				   (simplify-path
+-				    (path->complete-path (if (not (cadr m))
+-							     (bytes->path b)
+-							     (let-values ([(dir name dir?) (split-path exe)])
+-							       (if (bytes=? b #"")
+-								   dir
+-								   (build-path dir (bytes->path b)))))
+-							 (find-system-path 'orig-dir))))))]
+-		       [else (find-lib-dir)])
+-		      ;; no framework reference found!?
+-		      #f)))]
+-	     [else
+-	      (if (eq? 'shared (system-type 'link))
+-		  (or (force config:dll-dir)
+-		      (find-lib-dir))
+-		  #f)])))
++    (delay
++      (case (system-type)
++        [(windows)
++         ;; Extract "lib" location from binary:
++         (let ([exe (parameterize ([current-directory (system-path* 'orig-dir)])
++                      (find-executable-path (system-path* 'exec-file)))])
++           (with-input-from-file exe
++             (lambda ()
++               (let ([m (regexp-match (byte-regexp
++                                       (bytes-append
++                                        (bytes->utf-16-bytes #"dLl dIRECTORy:")
++                                        #"((?:..)*?)\0\0"))
++                                      (current-input-port))])
++                 (unless m
++                   (error "cannot find \"dLl dIRECTORy\" tag in binary"))
++                 (let-values ([(dir name dir?) (split-path exe)])
++                   (if (regexp-match #rx#"^<" (cadr m))
++                     ;; no DLL dir in binary
++                     #f
++                     ;; resolve relative directory:
++                     (let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))])
++                       (path->complete-path p dir))))))))]
++        [(macosx)
++         (let* ([exe (parameterize ([current-directory (system-path* 'orig-dir)])
++                       (let loop ([p (find-executable-path
++                                      (system-path* 'exec-file))])
++                         (if (link-exists? p)
++                           (loop (let-values ([(r) (resolve-path p)]
++                                              [(dir name dir?) (split-path p)])
++                                   (if (and (path? dir)
++                                            (relative-path? r))
++                                     (build-path dir r)
++                                     r)))
++                           p)))]
++                [rel (get/set-dylib-path exe "PLT_M[rz]" #f)])
++           (cond
++             [(not rel) #f] ; no framework reference found!?
++             [(regexp-match
++               #rx#"^(@executable_path/)?(.*?)PLT_M(?:rEd|zScheme).framework"
++               rel)
++              => (lambda (m)
++                   (let ([b (caddr m)])
++                     (if (and (not (cadr m)) (bytes=? b #""))
++                       #f ; no path in exe
++                       (simplify-path
++                        (path->complete-path
++                         (if (not (cadr m))
++                           (bytes->path b)
++                           (let-values ([(dir name dir?) (split-path exe)])
++                             (if (bytes=? b #"")
++                               dir
++                               (build-path dir (bytes->path b)))))
++                         (system-path* 'orig-dir))))))]
++             [else (find-lib-dir)]))]
++        [else
++         (if (eq? 'shared (system-type 'link))
++           (or (force config:dll-dir) (find-lib-dir))
++           #f)])))
+   (define (find-dll-dir)
+     (force dll-dir)))
+Index: collects/setup/main-collects.ss
+===================================================================
+--- collects/setup/main-collects.ss	(revision 4476)
++++ collects/setup/main-collects.ss	(revision 4477)
+@@ -1,16 +1,16 @@
+ (module main-collects mzscheme
+   (require "dirs.ss")
+-  
++
+   (provide path->main-collects-relative
+-	   main-collects-relative->path)
+-  
++           main-collects-relative->path)
++
+   ;; Historical note: this module is based on the old "plthome.ss"
+ 
+   ;; The `path->main-collects-relative' and
+   ;; `main-collects-relative->path' functions are used to store paths
+   ;; that are relative to the main "collects" directory, such as in
+   ;; .dep files.  This means that if the plt tree is moved, .dep files
+-  ;; still work. It is generally fine if
++  ;; still work.  It is generally fine if
+   ;; `path->main-collects-relative' misses some usages, as long as it
+   ;; works when we prepare a distribution tree.  Otherwise, things
+   ;; will continue to work fine and .dep files will just contain
+@@ -18,27 +18,25 @@
+   ;; either a pathname or a pair with a pathname in its cdr; the
+   ;; `path->main-collects-relative' pathname will itself be a pair.
+ 
++  ;; we need to compare paths to find when something is in the plt
++  ;; tree -- this does some basic "normalization" that should work
++  ;; fine: getting rid of `.' and `..' (simplify-path) and collapsing
++  ;; `//' to `/' (expand-path).  Using `expand-path' also expands `~'
++  ;; and `~user', but this should not be a problem in practice.
+   (define (simplify-bytes-path bytes)
+-    (path->bytes (simplify-path (bytes->path bytes))))
+-
++    (path->bytes (expand-path (simplify-path (bytes->path bytes)))))
++  ;; on Windows, turn backslashes to forward slashes
+   (define simplify-path*
+     (if (eq? 'windows (system-type))
+-	(lambda (str)
+-	  (regexp-replace* #rx#"\\\\" (simplify-bytes-path str) #"/"))
++	(lambda (bytes)
++          (simplify-bytes-path (regexp-replace* #rx#"\\\\" bytes #"/")))
+ 	simplify-bytes-path))
+ 
+-  (define main-collects-dir-bytes
+-    (delay (and (find-collects-dir)
+-		(path->bytes (find-collects-dir)))))
+-
+   (define main-collects-dir/
+-    (delay (and (force main-collects-dir-bytes)
+-		(regexp-replace #rx#"/?$" 
+-				(simplify-path* (force main-collects-dir-bytes))
+-				#"/"))))
+-  (define main-collects-dir/-len
+-    (delay (and (force main-collects-dir/)
+-		(bytes-length (force main-collects-dir/)))))
++    (delay (let ([dir (find-collects-dir)])
++             (and dir (regexp-replace #rx#"/*$"
++                                      (simplify-path* (path->bytes dir))
++                                      #"/")))))
+ 
+   (define (maybe-cdr-op fname f)
+     (lambda (x)
+@@ -53,14 +51,15 @@
+                        [else (error 'path->main-collects-relative
+                                     "expecting a byte-string, got ~e" path)])]
+            [path* (simplify-path* path)]
+-	   [mcd-len (force main-collects-dir/-len)])
++           [main-collects-dir/ (force main-collects-dir/)]
++	   [mcd-len (bytes-length main-collects-dir/)])
+       (cond [(and path*
+ 		  mcd-len
+                   (> (bytes-length path*) mcd-len)
+                   (equal? (subbytes path* 0 mcd-len)
+-			  (force main-collects-dir/)))
++			  main-collects-dir/))
+              (cons 'collects (subbytes path* mcd-len))]
+-            [(equal? path* (force main-collects-dir/)) (cons 'collects #"")]
++            [(equal? path* main-collects-dir/) (cons 'collects #"")]
+             [else path])))
+ 
+   ;; main-collects-relative->path* : datum-containing-bytes-or-path -> path
+@@ -77,6 +76,8 @@
+           [(bytes? path) (bytes->path path)]
+           [else path]))
+ 
+-  (define path->main-collects-relative (maybe-cdr-op 'path->main-collects-relative path->main-collects-relative*))
+-  (define main-collects-relative->path (maybe-cdr-op 'main-collects-relative->path main-collects-relative->path*))
++  (define path->main-collects-relative
++    (maybe-cdr-op 'path->main-collects-relative path->main-collects-relative*))
++  (define main-collects-relative->path
++    (maybe-cdr-op 'main-collects-relative->path main-collects-relative->path*))
+   )