Changeset 15119 in project


Ignore:
Timestamp:
06/30/09 13:55:24 (10 years ago)
Author:
felix winkelmann
Message:

deprecated getenv and canonical-path; normalize-pathname does most of canonicalizations

Location:
chicken/trunk
Files:
19 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/batch-driver.scm

    r15117 r15119  
    114114                       [(memq 'to-stdout options) #f]
    115115                       [else (make-pathname #f (if filename (pathname-file filename) "out") "c")] ) ]
    116         [ipath (map chop-separator (string-split (or (getenv "CHICKEN_INCLUDE_PATH") "") ";"))]
     116        [ipath (map chop-separator (string-split (or (get-environment-variable "CHICKEN_INCLUDE_PATH") "") ";"))]
    117117        [opasses default-optimization-passes]
    118118        [time0 #f]
  • chicken/trunk/chicken-install.scm

    r15077 r15119  
    6666
    6767  (define *program-path*
    68     (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     68    (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    6969          (make-pathname p "bin") )
    7070        (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
  • chicken/trunk/chicken.import.scm

    r15038 r15119  
    132132   get-output-string
    133133   get-properties
    134    getenv
     134   getenv                               ; DEPRECATED
    135135   getter-with-setter
    136136   implicit-exit-handler
  • chicken/trunk/chicken.scm

    r15037 r15119  
    7878   (remove
    7979    (lambda (x) (string=? x ""))
    80     (string-split (or (getenv "CHICKEN_OPTIONS") "")))
     80    (string-split (or (get-environment-variable "CHICKEN_OPTIONS") "")))
    8181   (cdr (argv))))
    8282
  • chicken/trunk/csc.scm

    r15117 r15119  
    6969  (exit 64) )
    7070
    71 (define chicken-prefix (getenv "CHICKEN_PREFIX"))
     71(define chicken-prefix (get-environment-variable "CHICKEN_PREFIX"))
    7272(define arguments (command-line-arguments))
    7373(define host-mode (member "-host" arguments))
     
    937937;;; Run it:
    938938
    939 (run (append (string-split (or (getenv "CSC_OPTIONS") "")) arguments))
     939(run (append (string-split (or (get-environment-variable "CSC_OPTIONS") "")) arguments))
  • chicken/trunk/csi.scm

    r15075 r15119  
    190190                (else (loop (fx+ i 1))) ) ) ) )
    191191    (lambda (name)
    192       (let ([path (getenv "PATH")])
     192      (let ([path (get-environment-variable "PATH")])
    193193        (and (> (##sys#size name) 0)
    194194             (cond [(dirseparator? (string-ref name 0)) (addext name)]
     
    873873
    874874(define (run)
    875   (let* ([extraopts (parse-option-string (or (getenv "CSI_OPTIONS") ""))]
     875  (let* ([extraopts (parse-option-string (or (get-environment-variable "CSI_OPTIONS") ""))]
    876876         [args (canonicalize-args (command-line-arguments))]
    877877         ; Check for these before 'args' is updated by any 'extraopts'
     
    898898           [quietflag (member* '("-q" "-quiet") args)]
    899899           [quiet (or script quietflag eval?)]
    900            [ipath (map chop-separator (string-split (or (getenv "CHICKEN_INCLUDE_PATH") "") ";"))] )     
     900           [ipath (map chop-separator (string-split (or (get-environment-variable "CHICKEN_INCLUDE_PATH") "") ";"))] )     
    901901      (define (collect-options opt)
    902902        (let loop ([opts args])
     
    911911          (if (file-exists? fn)
    912912              (load fn)
    913               (let* ([prefix (chop-separator (or (getenv "HOME") "."))]
     913              (let* ([prefix (chop-separator (or (get-environment-variable "HOME") "."))]
    914914                     [fn (string-append prefix "/" init-file)] )
    915915                (when (file-exists? fn)
  • chicken/trunk/eval.scm

    r15074 r15119  
    7474     ##sys#repl-eval-hook ##sys#append ##sys#eval-decorator
    7575     open-output-string get-output-string make-parameter software-type software-version machine-type
    76      build-platform getenv set-extensions-specifier! ##sys#string->symbol list->vector
     76     build-platform set-extensions-specifier! ##sys#string->symbol list->vector get-environment-variable
    7777     extension-information syntax-error ->string chicken-home ##sys#expand-curried-define
    7878     vector->list store-string open-input-string eval ##sys#gc
     
    127127
    128128(define ##sys#chicken-prefix
    129   (let ((prefix (and-let* ((p (getenv prefix-environment-variable)))
     129  (let ((prefix (and-let* ((p (get-environment-variable prefix-environment-variable)))
    130130                  (##sys#string-append
    131131                   p
     
    10851085(define ##sys#repository-path
    10861086  (make-parameter
    1087    (or (getenv repository-environment-variable)
     1087   (or (get-environment-variable repository-environment-variable)
    10881088       (##sys#chicken-prefix
    10891089        (##sys#string-append
  • chicken/trunk/files.scm

    r13677 r15119  
    5252      string-match regexp
    5353      ##sys#string-append ##sys#substring  string-append
    54       getenv
     54      get-environment-variable
    5555      file-exists? delete-file
    5656      call-with-output-file read-string)
     
    325325
    326326(define create-temporary-file
    327   (let ([getenv getenv]
     327  (let ([get-enviroment-variable get-environment-variable]
    328328        [make-pathname make-pathname]
    329329        [file-exists? file-exists?]
    330330        [call-with-output-file call-with-output-file] )
    331331    (lambda ext
    332       (let ([dir (or (getenv "TMPDIR") (getenv "TEMP") (getenv "TMP"))]
     332      (let ([dir (or (get-environment-variable "TMPDIR")
     333                     (get-environment-variable "TEMP")
     334                     (get-environment-variable "TMP"))]
    333335            [ext (if (pair? ext) (car ext) "tmp")])
    334336        (##sys#check-string ext 'create-temporary-file)
     
    343345;;; normalize pathname for a particular platform
    344346
    345 (define (normalize-pathname path #!optional (platform (build-platform)))
    346   (case platform
    347     ((mingw32 msvc)
    348      (string-translate path "/" "\\"))
    349     (else path)))
     347(define normalize-pathname
     348  (let ((open-output-string open-output-string)
     349        (get-output-string get-output-string)
     350        (get-environment-variable get-environment-variable)
     351        (reverse reverse)
     352        (display display))
     353    (lambda (path #!optional (platform (if (memq (build-platform) '(msvc mingw32)) 'windows 'unix)))
     354      (let ((sep (if (eq? platform 'windows) #\\ #\/)))
     355        (define (addpart part parts)
     356          (cond ((string=? "." part) parts)
     357                ((string=? ".." part)
     358                 (if (null? parts)
     359                     '("..")
     360                     (cdr parts)))
     361                (else (cons part parts))))
     362        (##sys#check-string path 'normalize-pathname)
     363        (let ((len (##sys#size path))
     364              (abspath #f)
     365              (drive #f))
     366          (let loop ((i 0) (prev 0) (parts '()))
     367            (cond ((fx>= i len)
     368                   (when (fx> i prev)
     369                     (set! parts (addpart (##sys#substring path prev i) parts)))
     370                   (if (null? parts)
     371                       (##sys#string-append "." (string sep))
     372                       (let ((out (open-output-string))
     373                             (parts (reverse parts)))
     374                         (display (car parts) out)
     375                         (for-each
     376                          (lambda (p)
     377                            (##sys#write-char-0 sep out)
     378                            (display p out) )
     379                          (cdr parts))
     380                         (when (fx= i prev) (##sys#write-char-0 sep out))
     381                         (let* ((r1 (get-output-string out))
     382                                (r (##sys#expand-home-path r1)))
     383                           (when (string=? r1 r)
     384                             (when abspath
     385                               (set! r (##sys#string-append (string sep) r)))
     386                             (when drive
     387                               (set! r (##sys#string-append drive r))))
     388                           r))))
     389                  ((memq (string-ref path i) '(#\\ #\/))
     390                   (when (and (null? parts) (fx= i prev))
     391                     (set! abspath #t))
     392                   (if (fx= i prev)
     393                       (loop (fx+ i 1) (fx+ i 1) parts)
     394                       (loop (fx+ i 1)
     395                             (fx+ i 1)
     396                             (addpart (##sys#substring path prev i) parts))))
     397                  ((and (null? parts)
     398                        (char=? (string-ref path i) #\:)
     399                        (eq? 'windows platform))
     400                   (set! drive (##sys#substring path 0 (fx+ i 1)))
     401                   (loop (fx+ i 1) (fx+ i 1) '()))
     402                  (else (loop (fx+ i 1) prev parts)))))))))
    350403
    351404
  • chicken/trunk/library.scm

    r15118 r15119  
    159159     ##sys#pointer->address number->string ##sys#flush-output ##sys#break-entry ##sys#step
    160160     ##sys#apply-values ##sys#get-call-chain ##sys#really-print-call-chain
    161      string->keyword keyword? string->keyword getenv ##sys#number->string ##sys#copy-bytes
     161     string->keyword keyword? string->keyword get-environment-variable ##sys#number->string ##sys#copy-bytes
    162162     call-with-current-continuation ##sys#string->number ##sys#inexact->exact ##sys#exact->inexact
    163163     ##sys#reverse-list->string reverse ##sys#inexact? list? string ##sys#char->utf8-string
     
    232232(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
    233233(define get-environment-variable (##core#primitive "C_get_environment_variable"))
    234 (define getenv get-environment-variable)
     234(define getenv get-environment-variable) ; DEPRECATED
    235235(define (##sys#start-timer) (##core#inline "C_start_timer"))
    236236(define ##sys#stop-timer (##core#primitive "C_stop_timer"))
     
    18531853              ((#\~)
    18541854               (let ((rest (##sys#substring path 1 len)))
    1855                  (##sys#string-append (or (getenv "HOME") "") rest) ) )
     1855                 (##sys#string-append (or (get-environment-variable "HOME") "") rest) ) )
    18561856              ((#\$)
    18571857               (let loop ((i 1))
  • chicken/trunk/manual/Unit files

    r15077 r15119  
    8787
    8888Performs a simple "normalization" on the {{PATHNAME}}, suitably for
    89 {{PLATFORM}}, which defaults to the value of {{(build-platform)}}.
    90 Currently, this just converts forward slashes to backslashes on Windows.
     89{{PLATFORM}}, which should be one of the symbols {{windows}}
     90or {{unix}} and defaults to on whatever platform is currently
     91in use. All relative path elements and duplicate separators are processed
     92and removed.  If {{NAME}} ends with
     93a {{/}} or is empty, the appropriate slash is appended to the tail.
     94Tilde {{~}} and variable {{$<name>/...}} expansion is also done.
     95
     96No directories or files are actually tested for existence; this
     97procedure only canonicalises path syntax.
    9198
    9299==== directory-null?
  • chicken/trunk/manual/Unit posix

    r15059 r15119  
    123123file-patterns (with {{*}} matching zero or more characters and
    124124{{?}} matching zero or one character).
    125 
    126 ==== canonical-path
    127 
    128 <procedure>(canonical-path NAME)</procedure>
    129 
    130 Returns a canonical path for {{NAME}}, which should be a string
    131 containing a path-or-filename.  The string returned by
    132 {{canonical-path}} is OS dependent; it may be quoted and used in
    133 a shell on the calling machine. (Quoting is suggested as shell
    134 special characters, including space, are not escaped.)  However,
    135 all path separators and prefixes are handled in an OS independent
    136 fashion.  Any appearance of {{/}} below imply {{\\}} is also handled.
    137 
    138 The prefix for {{NAME}} determines what path to prepend.  If {{NAME}}
    139 begins with a {{"~/"}}, this prefix is stripped and the user's
    140 home directory is added.  If beginning with {{/}} or a DRIVE-LETTER:\\
    141 combination, no additional path is added.  Otherwise, the current
    142 directory and separator are added.  All relative path elements and
    143 duplicate separators are processed and removed.  If {{NAME}} ends with
    144 a {{/}} or is empty, the appropriate slash is appended to the tail.
    145 
    146 No directories or files are actually tested for existence; this
    147 procedure only canonicalises path syntax.
    148125
    149126==== set-root-directory!
  • chicken/trunk/manual/faq

    r15059 r15119  
    415415{{boolean?}} {{number?}} {{complex?}} {{rational?}} {{real?}} {{exact?}} {{inexact?}} {{list?}} {{eof-object?}}
    416416{{string-ref}} {{string-set!}} {{vector-ref}} {{vector-set!}} {{char=?}} {{char<?}} {{char>?}} {{char<=?}} {{char>=?}}
    417 {{char-numeric?}} {{char-alphabetic?}} {{char-whitespace?}} {{char-upper-case?}}
     417{{char-numeric?}} {{char-alphabetic?}} {{char-whitespace?}} {{char-upper-case?}} {{for-each}}
    418418{{char-lower-case?}} {{char-upcae}} {{char-downcase}} {{list-tail}} {{assv}} {{memv}} {{memq}} {{assoc}}
    419419{{member}} {{set-car!}} {{set-cdr!}} {{abs}} {{exp}} {{sin}} {{cos}} {{tan}} {{log}} {{asin}} {{acos}} {{atan}} {{sqrt}}
     
    471471{{cpu-time}} {{error}} {{call/cc}} {{any?}}
    472472{{substring=?}} {{substring-ci=?}} {{substring-index}} {{substring-index-ci}}
     473{{printf}} {{sprintf}} {{fprintf}} {{format}}
    473474
    474475==== What's the difference betweem "block" and "local" mode?
  • chicken/trunk/posix.import.scm

    r15001 r15119  
    3030   call-with-input-pipe
    3131   call-with-output-pipe
    32    canonical-path
     32   canonical-path                       ; DEPRECATED
    3333   change-directory
    3434   change-file-mode
  • chicken/trunk/posixunix.scm

    r15001 r15119  
    487487     ##sys#make-port ##sys#file-info ##sys#update-errno ##sys#fudge ##sys#make-c-string ##sys#check-port
    488488     ##sys#error ##sys#signal-hook ##sys#peek-unsigned-integer make-pathname glob directory?
    489      pathname-file process-fork file-close duplicate-fileno process-execute getenv
     489     pathname-file process-fork file-close duplicate-fileno process-execute get-environment-variable
    490490     make-string make-input-port make-output-port ##sys#thread-block-for-i/o create-pipe
    491491     process-wait pathname-strip-directory ##sys#expand-home-path directory
     
    890890    (##sys#check-string name 'create-directory)
    891891    (if parents?
    892         (create-directory-helper-parents (canonical-path name))
    893         (create-directory-helper (canonical-path name)))))
    894 ;    (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string (##sys#expand-home-path name))))
    895 ;      (posix-error #:file-error 'create-directory "cannot create directory" name) ) ) )
     892        (create-directory-helper-parents name)
     893        (create-directory-helper name))))
    896894
    897895(define change-directory
     
    952950                (posix-error #:file-error 'current-directory "cannot retrieve current directory") ) ) ) ) ) )
    953951
    954 
    955 (define canonical-path
     952(define canonical-path                  ; DEPRECATED
    956953    (let ((null?      null?)
    957954          (char=?     char=?)
     
    963960          (isperse    (cut string-intersperse <> "/"))
    964961          (sep?       (lambda (c) (or (char=? #\/ c) (char=? #\\ c))))
    965           (getenv     getenv)
     962          (get-environment-variable     get-environment-variable)
    966963          (user       current-user-name)
    967964          (cwd        (let ((cw   current-directory))
     
    981978                                   (sep? (sref path 1)))
    982979                                 (sappend
    983                                      (or (getenv "HOME")
     980                                     (or (get-environment-variable "HOME")
    984981                                         (sappend "/home/" (user)))
    985982                                     (##sys#substring path 1
     
    22052202
    22062203(define (##sys#shell-command)
    2207   (or (getenv "SHELL") "/bin/sh") )
     2204  (or (get-environment-variable "SHELL") "/bin/sh") )
    22082205
    22092206(define (##sys#shell-command-arguments cmdlin)
  • chicken/trunk/posixwin.scm

    r15001 r15119  
    18871887
    18881888(define (##sys#shell-command)
    1889   (or (getenv "COMSPEC")
     1889  (or (get-environment-variable "COMSPEC")
    18901890      (if (##core#inline "C_get_shlcmd")
    18911891          _shlcmd
     
    18991899(define process-run
    19001900  (let ([process-spawn process-spawn]
    1901         [getenv getenv] )
     1901        [get-environment-variable get-environment-variable] )
    19021902    (lambda (f . args)
    19031903      (let ([args (if (pair? args) (car args) #f)])
  • chicken/trunk/setup-api.scm

    r15038 r15119  
    9191
    9292(define *chicken-bin-path*
    93   (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     93  (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    9494        (make-pathname p "bin") )
    9595      (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
    9696
    9797(define *doc-path*
    98   (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     98  (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    9999        (make-pathname p "share/chicken/doc") )
    100100      (make-pathname
     
    103103
    104104(define chicken-prefix
    105   (or (getenv "CHICKEN_PREFIX")
     105  (or (get-environment-variable "CHICKEN_PREFIX")
    106106      (let ((m (string-match "(.*)/bin/?" *chicken-bin-path*)))
    107107        (if m
     
    436436
    437437(define installation-prefix
    438   (make-parameter (or (getenv "CHICKEN_INSTALL_PREFIX") #f)))
     438  (make-parameter (or (get-environment-variable "CHICKEN_INSTALL_PREFIX") #f)))
    439439
    440440(define (write-info id files info)
     
    731731
    732732(define (create-temporary-directory)
    733   (let ((dir (or (getenv "TMPDIR") (getenv "TEMP") (getenv "TMP") "/tmp")))
     733  (let ((dir (or (get-environment-variable "TMPDIR")
     734                 (get-environment-variable "TEMP")
     735                 (get-environment-variable "TMP")
     736                 "/tmp")))
    734737    (let loop ()
    735738      (let* ((n (##sys#fudge 16))       ; current milliseconds
  • chicken/trunk/tests/path-tests.scm

    r13148 r15119  
    1818(assert (equal? "q/abc" (pathname-directory "q/abc/.def.ghi")))
    1919(assert (equal? "q/abc" (pathname-directory "q/abc/.ghi")))
     20
     21(define-syntax test
     22  (syntax-rules ()
     23    ((_ expected exp)
     24     (let ((result exp)
     25           (expd expected))
     26       (unless (equal? result expd)
     27         (error "test failed" result expd 'exp))))))
     28
     29(test "./" (normalize-pathname "" 'unix))
     30(test ".\\" (normalize-pathname "" 'windows))
     31(test "./" (normalize-pathname "/" 'unix))
     32(test "./" (normalize-pathname "./" 'unix))
     33(test "a" (normalize-pathname "a"))
     34(test "a/" (normalize-pathname "a/" 'unix))
     35(test "a/b" (normalize-pathname "a/b" 'unix))
     36(test "a/b" (normalize-pathname "a\\b" 'unix))
     37(test "a\\b" (normalize-pathname "a\\b" 'windows))
     38(test "a\\b" (normalize-pathname "a/b" 'windows))
     39(test "a/b/" (normalize-pathname "a/b/" 'unix))
     40(test "a/b/" (normalize-pathname "a/b//" 'unix))
     41(test "a/b" (normalize-pathname "a//b" 'unix))
     42(test "/a/b" (normalize-pathname "/a//b" 'unix))
     43(test "/a/b" (normalize-pathname "///a//b" 'unix))
     44(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
     45(test "c:/a/b" (normalize-pathname "c:/a/./b" 'unix))
     46(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
     47(test "c:b" (normalize-pathname "c:a/../b" 'windows))
     48(test "c:\\b" (normalize-pathname "c:\\a\\..\\b" 'windows))
     49(test "a/b" (normalize-pathname "a/./././b" 'unix))
     50(test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
     51(test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
     52
     53(define home (get-environment-variable "HOME"))
     54
     55(test (string-append home "/foo") (normalize-pathname "~/foo" 'unix))
     56(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
     57(test (string-append home "\\foo") (normalize-pathname "c:~\\foo" 'windows))
  • chicken/trunk/tests/runtests.sh

    r15077 r15119  
    128128
    129129echo "======================================== path tests ..."
    130 $compile path-tests.scm
    131 ./a.out
     130$interpret -bnq path-tests.scm
    132131
    133132echo "======================================== regular expression tests ..."
  • chicken/trunk/types.db

    r15076 r15119  
    329329(get-output-string (procedure get-output-string (port) string))
    330330(get-properties (procedure get-properties (symbol list) symbol * list))
    331 (getenv (procedure getenv (string) (or string boolean)))
     331(getenv deprecated)
    332332(getter-with-setter (procedure getter-with-setter (procedure procedure) procedure))
    333333(implicit-exit-handler (procedure implicit-exit-handler (#!optional procedure) procedure))
     
    634634(call-with-input-pipe (procedure call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
    635635(call-with-output-pipe (procedure call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
    636 (canonical-path (procedure canonical-path (string) string))
     636(canonical-path deprecated)
    637637(change-directory (procedure change-directory (string) undefined))
    638638(change-file-mode (procedure change-file-mode (string fixnum) undefined))
Note: See TracChangeset for help on using the changeset viewer.