Changeset 10099


Ignore:
Timestamp:
10/14/05 16:18:53 (16 years ago)
Author:
piso
Message:

Work in progress.

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/enough-namestring.lisp

    r10072 r10099  
    22;;;
    33;;; Copyright (C) 2004-2005 Peter Graves
    4 ;;; $Id: enough-namestring.lisp,v 1.5 2005-10-03 13:33:34 piso Exp $
     4;;; $Id: enough-namestring.lisp,v 1.6 2005-10-14 16:17:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2222(in-package #:system)
    2323
    24 (defun equal-components-p (this that)
    25   #+win32 (equalp this that)
    26   #-win32 (equal this that))
     24(declaim (inline equal-components-p))
     25(defun equal-components-p (component1 component2)
     26  #+win32 (equalp component1 component2)
     27  #-win32 (equal component1 component2))
    2728
    2829(defun enough-namestring (pathname
     
    4546                      (t
    4647                       (return-from enough-namestring (namestring pathname))))))
    47           (concatenate 'simple-string
    48                        (directory-namestring (make-pathname :directory result-directory))
    49                        (file-namestring pathname)))
     48          (if (equal result-directory '(:relative))
     49              (file-namestring pathname)
     50              (concatenate 'simple-string
     51                           (directory-namestring (make-pathname :directory result-directory))
     52                           (file-namestring pathname))))
    5053        (file-namestring pathname))))
  • trunk/j/src/org/armedbear/lisp/tests/pathname-tests.lisp

    r10097 r10099  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: pathname-tests.lisp,v 1.46 2005-10-13 16:59:16 piso Exp $
     4;;; $Id: pathname-tests.lisp,v 1.47 2005-10-14 16:18:53 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    307307  (check-physical-pathname #p"." nil "." nil)
    308308  t)
    309 #+(or cmu lispworks)
     309#+lispworks
    310310(pushnew 'physical.22 *expected-failures*)
     311
     312(deftest namestring.1
     313  (check-namestring #p"."
     314                    #+(or abcl allegro cmu) "./"
     315                    #-(or abcl allegro cmu) ".")
     316  t)
     317#+lispworks
     318(pushnew 'namestring.1 *expected-failures*)
    311319
    312320(deftest physical.23
     
    327335    (check-physical-pathname pathname '(:relative ".") nil nil))
    328336  t)
    329 #+(or cmu lispworks (and allegro windows))
     337#+(or lispworks (and allegro windows))
    330338(pushnew 'physical.24 *expected-failures*)
     339
     340(deftest namestring.2
     341  (check-namestring #-windows #p"./"
     342                    #+windows #p".\\"
     343                    "./")
     344  t)
     345#+lispworks
     346(pushnew 'namestring.2 *expected-failures*)
     347
     348(deftest directory-namestring.1
     349  (equal (directory-namestring #-windows #p"./"
     350                               #+windows #p".\\")
     351         #-windows "./"
     352         #+windows ".\\")
     353  t)
    331354
    332355(deftest physical.25
     
    374397(pushnew 'physical.28 *expected-failures*)
    375398
     399(deftest namestring.3
     400  (check-namestring #p".."
     401                    #+(or abcl allegro cmu lispworks) "../"
     402                    #-(or abcl allegro cmu lispworks) "..")
     403  t)
     404
    376405;; #p"../"
    377406(deftest physical.29
     
    382411    #+(or abcl sbcl cmu clisp (and lispworks unix))
    383412    (check-physical-pathname pathname '(:relative :up) nil nil))
     413  t)
     414
     415(deftest namestring.4
     416  (check-namestring #-windows #p"../"
     417                    #+windows #p"..\\"
     418                    "../")
     419  t)
     420
     421(deftest directory-namestring.2
     422  (equal (directory-namestring #-windows #p"../"
     423                               #+windows #p"..\\")
     424         #-windows "../"
     425         #+windows "..\\")
    384426  t)
    385427
     
    918960
    919961;; "TRANSLATE-PATHNAME translates SOURCE (that matches FROM-WILDCARD)..."
    920 (deftest pathname-match-p.10
     962(deftest pathname-match-p.11
    921963  (pathname-match-p "/foo/bar.txt" "**/*.*")
    922964  nil)
     
    933975  t)
    934976
    935 (deftest pathname-match-p.11
     977(deftest pathname-match-p.12
    936978  (pathname-match-p "/foo/bar.txt" "/**/*.*")
    937979  t)
Note: See TracChangeset for help on using the changeset viewer.