Changeset 27286 in project


Ignore:
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:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/setup-helper/tags/1.5.3/setup-helper.scm

    r26550 r27286  
    1111
    1212(use
    13         srfi-1
    14         posix
    15         extras
    16         data-structures
    17         files
    18         setup-api)
     13  srfi-1
     14  posix
     15  extras
     16  data-structures
     17  files
     18  setup-api)
    1919
    2020(define *has-emit-inline* #f)
    2121(define *has-emit-types* #f)
    2222(when (version>=? (chicken-version) "4.0.0")
    23         (set! *has-emit-inline* #t) )
     23  (set! *has-emit-inline* #t) )
    2424(when (version>=? (chicken-version) "4.7.3")
    25         (set! *has-emit-types* #t) )
     25  (set! *has-emit-types* #t) )
    2626
    2727;;; Extension Information
     
    3737
    3838(define (sh:error-type loc obj #!optional typmsg)
    39         (let* ((msg "bad argument type")
    40                                 (msg (if typmsg (string-append msg " - not a " typmsg))) )
    41                 (##sys#signal-hook #:type-error loc msg obj) ) )
     39  (let* ((msg "bad argument type")
     40        (msg (if typmsg (string-append msg " - not a " typmsg))) )
     41    (##sys#signal-hook #:type-error loc msg obj) ) )
    4242
    4343;; Filename Support
     
    6262    (make-pathname `(,(installation-prefix) "share") "chicken") ) )
    6363
     64; from repo-path in setup-helper.scm
    6465(define (installation-repository-path)
    65   (repository-path) )
     66  (if (deployment-mode)
     67    (installation-prefix) ; deploy: copy directly into destdir
     68    (let ((p (destination-prefix)))
     69      (if p
     70        ; installation-prefix changed: use it
     71        (make-pathname p (sprintf "lib/chicken/~a" (##sys#fudge 42)))
     72        ; otherwise use repo-path
     73        (repository-path) ) ) ) )
    6674
    6775(define (directory-separator? obj)
     
    147155  (copy-file-relative fn dn) )
    148156
     157(define (copy-to-installation-repository fn)
     158  (copy-file-relative fn (installation-repository-path)) )
     159
    149160(define (copy-to-repository fn)
    150   (copy-file-relative fn (installation-repository-path)) )
     161  (copy-to-installation-repository fn) )
    151162
    152163(define (copy-to-home fn)
     
    269280
    270281(define (has-emit-inline inline? nam)
    271         (if (not (and *has-emit-inline* inline?)) '()
    272                 `(-emit-inline-file ,(inline-filename nam)) ) )
     282  (if (not (and *has-emit-inline* inline?)) '()
     283    `(-emit-inline-file ,(inline-filename nam)) ) )
    273284
    274285(define (has-emit-types types? nam)
    275         (if (not (and *has-emit-types* types?)) '()
    276                 `(-emit-type-file ,(types-filename nam)) ) )
     286  (if (not (and *has-emit-types* types?)) '()
     287    `(-emit-type-file ,(types-filename nam)) ) )
    277288
    278289;compile expands using back-quote
  • release/4/setup-helper/tags/1.5.3/setup-helper.setup

    r26550 r27286  
    11;;;; setup-helper.setup -*- Hen -*-
    22
    3 (define this-verno "1.5.2")
     3(define this-verno "1.5.3")
    44
    55(define (shared-filename bn)
  • release/4/setup-helper/trunk/setup-helper.scm

    r26550 r27286  
    1111
    1212(use
    13         srfi-1
    14         posix
    15         extras
    16         data-structures
    17         files
    18         setup-api)
     13  srfi-1
     14  posix
     15  extras
     16  data-structures
     17  files
     18  setup-api)
    1919
    2020(define *has-emit-inline* #f)
    2121(define *has-emit-types* #f)
    2222(when (version>=? (chicken-version) "4.0.0")
    23         (set! *has-emit-inline* #t) )
     23  (set! *has-emit-inline* #t) )
    2424(when (version>=? (chicken-version) "4.7.3")
    25         (set! *has-emit-types* #t) )
     25  (set! *has-emit-types* #t) )
    2626
    2727;;; Extension Information
     
    3737
    3838(define (sh:error-type loc obj #!optional typmsg)
    39         (let* ((msg "bad argument type")
    40                                 (msg (if typmsg (string-append msg " - not a " typmsg))) )
    41                 (##sys#signal-hook #:type-error loc msg obj) ) )
     39  (let* ((msg "bad argument type")
     40        (msg (if typmsg (string-append msg " - not a " typmsg))) )
     41    (##sys#signal-hook #:type-error loc msg obj) ) )
    4242
    4343;; Filename Support
     
    6262    (make-pathname `(,(installation-prefix) "share") "chicken") ) )
    6363
     64; from repo-path in setup-helper.scm
    6465(define (installation-repository-path)
    65   (repository-path) )
     66  (if (deployment-mode)
     67    (installation-prefix) ; deploy: copy directly into destdir
     68    (let ((p (destination-prefix)))
     69      (if p
     70        ; installation-prefix changed: use it
     71        (make-pathname p (sprintf "lib/chicken/~a" (##sys#fudge 42)))
     72        ; otherwise use repo-path
     73        (repository-path) ) ) ) )
    6674
    6775(define (directory-separator? obj)
     
    147155  (copy-file-relative fn dn) )
    148156
     157(define (copy-to-installation-repository fn)
     158  (copy-file-relative fn (installation-repository-path)) )
     159
    149160(define (copy-to-repository fn)
    150   (copy-file-relative fn (installation-repository-path)) )
     161  (copy-to-installation-repository fn) )
    151162
    152163(define (copy-to-home fn)
     
    269280
    270281(define (has-emit-inline inline? nam)
    271         (if (not (and *has-emit-inline* inline?)) '()
    272                 `(-emit-inline-file ,(inline-filename nam)) ) )
     282  (if (not (and *has-emit-inline* inline?)) '()
     283    `(-emit-inline-file ,(inline-filename nam)) ) )
    273284
    274285(define (has-emit-types types? nam)
    275         (if (not (and *has-emit-types* types?)) '()
    276                 `(-emit-type-file ,(types-filename nam)) ) )
     286  (if (not (and *has-emit-types* types?)) '()
     287    `(-emit-type-file ,(types-filename nam)) ) )
    277288
    278289;compile expands using back-quote
  • release/4/setup-helper/trunk/setup-helper.setup

    r26550 r27286  
    11;;;; setup-helper.setup -*- Hen -*-
    22
    3 (define this-verno "1.5.2")
     3(define this-verno "1.5.3")
    44
    55(define (shared-filename bn)
Note: See TracChangeset for help on using the changeset viewer.