Changeset 27286 in project

Timestamp:

08/23/12 21:59:02 (9 years ago)

Author:

Kon Lovett

Message:

Fix for bug #904, use repo-path in setup-helper.scm installation path definition.

Location:

release/4/setup-helper

Files:

• tags/1.5.3 (copied) (copied from release/4/setup-helper/trunk)
• tags/1.5.3/setup-helper.scm (modified) (5 diffs)
• tags/1.5.3/setup-helper.setup (modified) (1 diff)
• trunk/setup-helper.scm (modified) (5 diffs)
• trunk/setup-helper.setup (modified) (1 diff)

release/4/setup-helper/tags/1.5.3/setup-helper.scm

@@ -11 +11 @@
 
 (use
-        srfi-1
-        posix
-        extras
-        data-structures
-        files
-        setup-api)
+  srfi-1
+  posix
+  extras
+  data-structures
+  files
+  setup-api)
 
 (define *has-emit-inline* #f)
 (define *has-emit-types* #f)
 (when (version>=? (chicken-version) "4.0.0")
-        (set! *has-emit-inline* #t) )
+  (set! *has-emit-inline* #t) )
 (when (version>=? (chicken-version) "4.7.3")
-        (set! *has-emit-types* #t) )
+  (set! *has-emit-types* #t) )
 
 ;;; Extension Information
@@ -37 +37 @@
 
 (define (sh:error-type loc obj #!optional typmsg)
-        (let* ((msg "bad argument type")
-                                 (msg (if typmsg (string-append msg " - not a " typmsg))) )
-                (##sys#signal-hook #:type-error loc msg obj) ) )
+  (let* ((msg "bad argument type")
+         (msg (if typmsg (string-append msg " - not a " typmsg))) )
+    (##sys#signal-hook #:type-error loc msg obj) ) )
 
 ;; Filename Support
@@ -62 +62 @@
     (make-pathname `(,(installation-prefix) "share") "chicken") ) )
 
+; from repo-path in setup-helper.scm
 (define (installation-repository-path)
-  (repository-path) )
+  (if (deployment-mode)
+    (installation-prefix) ; deploy: copy directly into destdir
+    (let ((p (destination-prefix)))
+      (if p
+        ; installation-prefix changed: use it
+        (make-pathname p (sprintf "lib/chicken/~a" (##sys#fudge 42)))
+        ; otherwise use repo-path
+        (repository-path) ) ) ) )
 
 (define (directory-separator? obj)
@@ -147 +155 @@
   (copy-file-relative fn dn) )
 
+(define (copy-to-installation-repository fn)
+  (copy-file-relative fn (installation-repository-path)) )
+
 (define (copy-to-repository fn)
-  (copy-file-relative fn (installation-repository-path)) )
+  (copy-to-installation-repository fn) )
 
 (define (copy-to-home fn)
@@ -269 +280 @@
 
 (define (has-emit-inline inline? nam)
-        (if (not (and *has-emit-inline* inline?)) '()
-                `(-emit-inline-file ,(inline-filename nam)) ) )
+  (if (not (and *has-emit-inline* inline?)) '()
+    `(-emit-inline-file ,(inline-filename nam)) ) )
 
 (define (has-emit-types types? nam)
-        (if (not (and *has-emit-types* types?)) '()
-                `(-emit-type-file ,(types-filename nam)) ) )
+  (if (not (and *has-emit-types* types?)) '()
+    `(-emit-type-file ,(types-filename nam)) ) )
 
 ;compile expands using back-quote

release/4/setup-helper/tags/1.5.3/setup-helper.setup

@@ -1 +1 @@
 ;;;; setup-helper.setup -*- Hen -*-
 
-(define this-verno "1.5.2")
+(define this-verno "1.5.3")
 
 (define (shared-filename bn)

release/4/setup-helper/trunk/setup-helper.scm

@@ -11 +11 @@
 
 (use
-        srfi-1
-        posix
-        extras
-        data-structures
-        files
-        setup-api)
+  srfi-1
+  posix
+  extras
+  data-structures
+  files
+  setup-api)
 
 (define *has-emit-inline* #f)
 (define *has-emit-types* #f)
 (when (version>=? (chicken-version) "4.0.0")
-        (set! *has-emit-inline* #t) )
+  (set! *has-emit-inline* #t) )
 (when (version>=? (chicken-version) "4.7.3")
-        (set! *has-emit-types* #t) )
+  (set! *has-emit-types* #t) )
 
 ;;; Extension Information
@@ -37 +37 @@
 
 (define (sh:error-type loc obj #!optional typmsg)
-        (let* ((msg "bad argument type")
-                                 (msg (if typmsg (string-append msg " - not a " typmsg))) )
-                (##sys#signal-hook #:type-error loc msg obj) ) )
+  (let* ((msg "bad argument type")
+         (msg (if typmsg (string-append msg " - not a " typmsg))) )
+    (##sys#signal-hook #:type-error loc msg obj) ) )
 
 ;; Filename Support
@@ -62 +62 @@
     (make-pathname `(,(installation-prefix) "share") "chicken") ) )
 
+; from repo-path in setup-helper.scm
 (define (installation-repository-path)
-  (repository-path) )
+  (if (deployment-mode)
+    (installation-prefix) ; deploy: copy directly into destdir
+    (let ((p (destination-prefix)))
+      (if p
+        ; installation-prefix changed: use it
+        (make-pathname p (sprintf "lib/chicken/~a" (##sys#fudge 42)))
+        ; otherwise use repo-path
+        (repository-path) ) ) ) )
 
 (define (directory-separator? obj)
@@ -147 +155 @@
   (copy-file-relative fn dn) )
 
+(define (copy-to-installation-repository fn)
+  (copy-file-relative fn (installation-repository-path)) )
+
 (define (copy-to-repository fn)
-  (copy-file-relative fn (installation-repository-path)) )
+  (copy-to-installation-repository fn) )
 
 (define (copy-to-home fn)
@@ -269 +280 @@
 
 (define (has-emit-inline inline? nam)
-        (if (not (and *has-emit-inline* inline?)) '()
-                `(-emit-inline-file ,(inline-filename nam)) ) )
+  (if (not (and *has-emit-inline* inline?)) '()
+    `(-emit-inline-file ,(inline-filename nam)) ) )
 
 (define (has-emit-types types? nam)
-        (if (not (and *has-emit-types* types?)) '()
-                `(-emit-type-file ,(types-filename nam)) ) )
+  (if (not (and *has-emit-types* types?)) '()
+    `(-emit-type-file ,(types-filename nam)) ) )
 
 ;compile expands using back-quote

release/4/setup-helper/trunk/setup-helper.setup

@@ -1 +1 @@
 ;;;; setup-helper.setup -*- Hen -*-
 
-(define this-verno "1.5.2")
+(define this-verno "1.5.3")
 
 (define (shared-filename bn)