Changeset 15782 for release/1.9/source


Ignore:
Timestamp:
Mar 21, 2013, 10:48:52 PM (6 years ago)
Author:
gb
Message:

Propagate r15776 to 1.9.

Location:
release/1.9/source
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • release/1.9/source/level-1/l1-files.lisp

    r15755 r15782  
    8080    (t (report-bad-arg if-does-not-exist '(member :error :create nil)))))
    8181
     82
     83(defun defaulted-native-namestring (path)
     84  (native-translated-namestring (merge-pathnames path)))
    8285
    8386(defun native-translated-namestring (path)
     
    191194  otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
    192195  (check-pathname-not-wild path)
    193   (let* ((native (native-translated-namestring path))
     196  (let* ((native (defaulted-native-namestring path))
    194197         (realpath (%realpath native))
    195198         (kind (if realpath (%unix-file-kind realpath))))
     
    206209
    207210(defun cwd (path) 
    208   (multiple-value-bind (realpath kind) (%probe-file-x (native-translated-namestring path))
     211  (multiple-value-bind (realpath kind) (%probe-file-x (defaulted-native-namestring path))
    209212    (if kind
    210213      (if (eq kind :directory)
     
    229232  (when (directory-pathname-p path)
    230233    (return-from %create-file (probe-file-x path)))
    231   (let* ((unix-name (native-translated-namestring path))
     234  (let* ((unix-name (defaulted-native-namestring path))
    232235         (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT
    233236                                        (if (eq if-exists :overwrite)
     
    11581161  "Return file's creation date, or NIL if it doesn't exist.
    11591162  An error of type file-error is signaled if file is a wild pathname"
    1160   (%file-write-date (native-translated-namestring path)))
     1163  (%file-write-date (defaulted-native-namestring path)))
    11611164
    11621165(defun file-author (path)
     
    11641167  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
    11651168  or FILE is a wild pathname."
    1166   (%file-author (native-translated-namestring path)))
     1169  (%file-author (defaulted-native-namestring path)))
    11671170
    11681171(defun touch (path)
     
    11731176              (pathname-type path))
    11741177        (create-file path)))
    1175     (%utimes (native-translated-namestring path)))
     1178    (%utimes (defaulted-native-namestring path)))
    11761179  t)
    11771180
     
    12011204                   (values true-fasl merged fasl))
    12021205                  ((and (multiple-value-setq (full-name kind)
    1203                           (let* ((realpath (%realpath (native-translated-namestring full-name))))
     1206                          (let* ((realpath (%realpath (defaulted-native-namestring full-name))))
    12041207                            (if realpath
    12051208                              (%probe-file-x realpath ))))
     
    13141317                        (namestring p)))
    13151318                 (restart-case (multiple-value-bind (winp err)
    1316                                    (%fasload (native-translated-namestring file-name))
     1319                                   (%fasload (defaulted-native-namestring file-name))
    13171320                                 (if (not winp)
    13181321                                   (%err-disp err)))
     
    13781381(defun delete-file (path)
    13791382  "Delete the specified FILE."
    1380   (let* ((namestring (native-translated-namestring path))
     1383  (let* ((namestring (defaulted-native-namestring path))
    13811384         (err (%delete-file namestring)))
    13821385    (or (eql 0 err) (signal-file-error err path))))
  • release/1.9/source/level-1/l1-sockets.lisp

    r15599 r15782  
    12531253                     (parse-foreign-type '(:struct :sockaddr_un)) :sun_path)))
    12541254                  8)))
    1255     (let* ((name (native-translated-namestring path))
     1255    (let* ((name (defaulted-native-namestring path))
    12561256           (namelen (length name))
    12571257           (pathlen (sockaddr_un-path-len))
  • release/1.9/source/level-1/l1-streams.lisp

    r15536 r15782  
    59215921
    59225922(defun probe-file-x (path)
    5923   (%probe-file-x (native-translated-namestring path)))
     5923  (%probe-file-x (defaulted-native-namestring path)))
    59245924
    59255925(defun file-length (stream)
  • release/1.9/source/level-1/linux-files.lisp

    r15706 r15782  
    560560   permission problems.  Any other failures cause an error to be signalled"
    561561  (multiple-value-bind (win mode ignore mtime-sec ignore uid ignore mtime-usec gid)
    562                        (%stat (native-translated-namestring source-path) t)
     562                       (%stat (defaulted-native-namestring source-path) t)
    563563    (declare (ignore ignore))
    564564    (unless win
    565565      (error "Cannot get attributes of ~s" source-path))
    566     (with-filename-cstrs ((cnamestr (native-translated-namestring dest-path)))
     566    (with-filename-cstrs ((cnamestr (defaulted-native-namestring dest-path)))
    567567      (macrolet ((errchk (form)
    568568                   `(let ((err ,form))
     
    24172417    (let* ((bits-per-element (integer-length (- (numeric-ctype-high upgraded-ctype)
    24182418                                                (numeric-ctype-low upgraded-ctype))))
    2419            (fd (fd-open (native-translated-namestring pathname) #$O_RDONLY)))
     2419           (fd (fd-open (defaulted-native-namestring pathname) #$O_RDONLY)))
    24202420      (if (< fd 0)
    24212421        (signal-file-error fd pathname)
  • release/1.9/source/lib/db-io.lisp

    r14525 r15782  
    7373#+openmcl
    7474(progn
     75
     76  #-BOOTSTRAPPED ;; remove once bootstrapped.
     77  (unless (fboundp 'defaulted-native-namestring) (fset 'defaulted-native-namestring #'native-translated-namestring))
     78
    7579  ;;; Given a (possibly logical) PATHNAME, return a corresponding namestring
    7680  ;;; suitable for passing to an OS file-open call.
    7781  (defun cdb-native-namestring (pathname)
    78     (native-translated-namestring pathname))
     82    (defaulted-native-namestring pathname))
    7983 
    8084  ;;; Open the file specified by PATHNAME for output and return a
  • release/1.9/source/lib/dumplisp.lisp

    r15195 r15782  
    8383                                     :directory (pathname-directory (translate-logical-pathname filename))))
    8484    (error "Directory containing ~s does not exist." filename))
    85   (let* ((kind (%unix-file-kind (native-translated-namestring filename))))
     85  (let* ((kind (%unix-file-kind (defaulted-native-namestring filename))))
    8686    (when (and kind (not (eq kind :file )))
    8787      (error "~S is not a regular file." filename)))
     
    292292                         (if (eq prepend-kernel t)
    293293                           (kernel-path)
    294                            (native-translated-namestring
    295                           (pathname prepend-kernel)))))
     294                           (defaulted-native-namestring
     295                            (pathname prepend-kernel)))))
    296296         (prepend-fd (if prepend-path (fd-open prepend-path #$O_RDONLY)))
    297297         (prepend-len (if prepend-kernel
     
    299299                          (skip-embedded-image prepend-fd)
    300300                          (signal-file-error prepend-fd prepend-path))))
    301          (filename (native-translated-namestring path)))
     301         (filename (defaulted-native-namestring path)))
    302302    (when (probe-file filename)
    303303      (%delete-file filename))
  • release/1.9/source/lib/pathnames.lisp

    r15543 r15782  
    9898  file, then the associated file is renamed."
    9999  (let* ((original (truename file))
    100          (original-namestring (native-translated-namestring original))
     100         (original-namestring (defaulted-native-namestring original))
    101101         (new-name (merge-pathnames new-name (merge-pathnames file)))
    102          (new-namestring (native-translated-namestring new-name)))
     102         (new-namestring (defaulted-native-namestring new-name)))
    103103    (unless new-namestring
    104104      (error "~S can't be created." new-name))
     
    162162
    163163(defun delete-empty-directory (path)
    164   (let* ((namestring (native-translated-namestring path))
     164  (let* ((namestring (defaulted-native-namestring path))
    165165         (err (%rmdir namestring)))
    166166    (or (eql 0 err) (signal-file-error err path))))
     
    168168(defun delete-directory (path)
    169169  "Delete specified directory and all its contents."
    170   (let ((namestring (native-translated-namestring path)))
     170  (let ((namestring (defaulted-native-namestring path)))
    171171    (if (eq :directory (%unix-file-kind namestring t))
    172172      (let* ((dir (ensure-directory-pathname path))
     
    187187;;; blows away a directory and all its contents
    188188(defun recursive-delete-directory (path &key (if-does-not-exist :error))
    189   (setq path (ensure-directory-pathname path))
     189  (setq path (make-pathname :name nil :type nil
     190                            :defaults (merge-pathnames (ensure-directory-pathname path))))
    190191  (setq if-does-not-exist (require-type if-does-not-exist '(member :error nil)))
    191192  (when (eq if-does-not-exist :error)
     
    198199                 (files (directory pattern :directories nil :files t))
    199200                 (subdirs (directory pattern :directories t :files nil))
    200                  (target-pathname (native-translated-namestring path)))
     201                 (target-pathname (defaulted-native-namestring path)))
    201202            (dolist (f files)
    202203              (delete-file f))
     
    236237                      :device (pathname-device pathname)
    237238                      :directory (subseq parent-dirs 0 i)))
    238              (parent-name (native-translated-namestring parent))
     239             (parent-name (defaulted-native-namestring parent))
    239240             (parent-kind (%unix-file-kind parent-name)))
    240241
     
    316317;is a dir. - should we doc this - its exported?
    317318(defun directoryp (path)
    318   (let* ((native (native-translated-namestring path))
     319  (let* ((native (defaulted-native-namestring path))
    319320         (realpath (%realpath native)))
    320321    (if realpath (eq (%unix-file-kind realpath) :directory))))
  • release/1.9/source/library/core-files.lisp

    r14680 r15782  
    166166#-run-external-program-to-find-sections
    167167(defun sections-from-elf-file (pathname)
    168   (let* ((fd (fd-open (native-translated-namestring pathname) #$O_RDONLY)))
     168  (let* ((fd (fd-open (defaulted-native-namestring pathname) #$O_RDONLY)))
    169169    (if (< fd 0)
    170170      (signal-file-error fd pathname)
     
    234234                 collect (subseq line start next)
    235235                 do (setq start next))))
    236     (let* ((file (native-translated-namestring pathname))
     236    (let* ((file (defaulted-native-namestring pathname))
    237237           (string (with-output-to-string (output)
    238238                     #+readelf (ccl:run-program "readelf" `("--sections" "--wide" ,file) :output output)
Note: See TracChangeset for help on using the changeset viewer.