tests/filesys.test.sh

   1 #!/bin/sh
   2
   3 # This software is part of the SBCL system. See the README file for
   4 # more information.
   5 #
   6 # While most of SBCL is derived from the CMU CL system, the test
   7 # files (like this one) were written from scratch after the fork
   8 # from CMU CL.
   9 #
  10 # This software is in the public domain and is provided with
  11 # absolutely no warranty. See the COPYING and CREDITS files for
  12 # more information.
  13
  14 # Test DIRECTORY and TRUENAME.
  15 testdir=`/bin/pwd`"/filesys-test-$$"
  16 mkdir $testdir
  17 echo this is a test > $testdir/test-1.tmp
  18 echo this is a test > $testdir/test-2.tmp
  19 echo this is a test > $testdir/wild\?test.tmp
  20 cd $testdir
  21 ln -s $testdir dirlinktest
  22 ln -s test-1.tmp link-1
  23 ln -s `pwd`/test-2.tmp link-2
  24 ln -s i-do-not-exist link-3
  25 ln -s link-4 link-4
  26 ln -s link-5 link-6
  27 ln -s `pwd`/link-6 link-5
  28 expected_truenames=\
  29 "'(#p\"$testdir/\"\
  30    #p\"$testdir/link-3\"\
  31    #p\"$testdir/link-4\"\
  32    #p\"$testdir/link-5\"\
  33    #p\"$testdir/link-6\"\
  34    #p\"$testdir/test-1.tmp\"\
  35    #p\"$testdir/test-2.tmp\"\
  36    #p\"$testdir/wild\\\\?test.tmp\")"
  37 $SBCL <<EOF
  38   (in-package :cl-user)
  39   (let* ((directory (directory "./*.*"))
  40          (truenames (sort directory #'string< :key #'pathname-name)))
  41     (format t "~&TRUENAMES=~S~%" truenames)
  42     (finish-output)
  43     (assert (equal truenames $expected_truenames)))
  44   (assert (equal (truename "dirlinktest") #p"$testdir/"))
  45   (assert (equal (truename "dirlinktest/") #p"$testdir/"))
  46   (assert (equal (truename "test-1.tmp") #p"$testdir/test-1.tmp"))
  47   (assert (equal (truename "link-1")     #p"$testdir/test-1.tmp"))
  48   (assert (equal (truename "link-2")     #p"$testdir/test-2.tmp"))
  49   (assert (equal (truename "link-3")     #p"$testdir/link-3"))
  50   (assert (equal (truename "link-4")     #p"$testdir/link-4"))
  51   (assert (equal (truename "link-5")     #p"$testdir/link-5"))
  52   (assert (equal (truename "link-6")     #p"$testdir/link-6"))
  53   (sb-ext:quit :unix-status 52)
  54 EOF
  55 if [ $? != 52 ]; then
  56     echo DIRECTORY/TRUENAME test part 1 failed, unexpected SBCL return code=$?
  57     exit 1
  58 fi
  59 cd ..
  60 $SBCL <<EOF
  61   (in-package :cl-user)
  62   (let* ((directory (directory "$testdir/*.*"))
  63          (truenames (sort directory #'string< :key #'pathname-name)))
  64     (format t "~&TRUENAMES=~S~%" truenames)
  65     (finish-output)
  66     (assert (equal truenames $expected_truenames)))
  67   (assert (equal (truename "$testdir/test-1.tmp") #p"$testdir/test-1.tmp"))
  68   (assert (equal (truename "$testdir/link-1")     #p"$testdir/test-1.tmp"))
  69   (assert (equal (truename "$testdir/link-2")     #p"$testdir/test-2.tmp"))
  70   (assert (equal (truename "$testdir/link-3")     #p"$testdir/link-3"))
  71   (assert (equal (truename "$testdir/link-4")     #p"$testdir/link-4"))
  72   (assert (equal (truename "$testdir/link-5")     #p"$testdir/link-5"))
  73   (assert (equal (truename "$testdir/link-6")     #p"$testdir/link-6"))
  74   (sb-ext:quit :unix-status 52)
  75 EOF
  76 if [ $? != 52 ]; then
  77     echo DIRECTORY/TRUENAME test part 2 failed, unexpected SBCL return code=$?
  78     exit 1
  79 fi
  80 rm -r $testdir
  81
  82 # Test DIRECTORY on a tree structure of directories.
  83 mkdir $testdir
  84 cd $testdir
  85 touch water dirt
  86 mkdir animal plant
  87 mkdir animal/vertebrate animal/invertebrate
  88 mkdir animal/vertebrate/mammal
  89 mkdir animal/vertebrate/snake
  90 mkdir animal/vertebrate/bird
  91 mkdir animal/vertebrate/mammal/bear
  92 mkdir animal/vertebrate/mammal/mythical
  93 mkdir animal/vertebrate/mammal/rodent
  94 mkdir animal/vertebrate/mammal/ruminant
  95 touch animal/vertebrate/mammal/platypus
  96 touch animal/vertebrate/mammal/walrus
  97 touch animal/vertebrate/mammal/bear/grizzly
  98 touch animal/vertebrate/mammal/mythical/mermaid
  99 touch animal/vertebrate/mammal/mythical/unicorn
 100 touch animal/vertebrate/mammal/rodent/beaver
 101 touch animal/vertebrate/mammal/rodent/mouse
 102 touch animal/vertebrate/mammal/rodent/rabbit
 103 touch animal/vertebrate/mammal/rodent/rat
 104 touch animal/vertebrate/mammal/ruminant/cow
 105 touch animal/vertebrate/snake/python
 106 touch plant/kingsfoil plant/pipeweed
 107 $SBCL <<EOF
 108 (in-package :cl-user)
 109 (defun absolutify (pathname)
 110   "Convert a possibly-relative pathname to absolute."
 111   (merge-pathnames pathname
 112                    (make-pathname :directory
 113                                   (pathname-directory
 114                                    *default-pathname-defaults*))))
 115 (defun sorted-truenamestrings (pathname-designators)
 116   "Convert a collection of pathname designators into canonical form
 117 using TRUENAME, NAMESTRING, and SORT."
 118   (sort (mapcar #'namestring
 119                 (mapcar #'truename
 120                         pathname-designators))
 121         #'string<))
 122 (defun need-match-1 (directory-pathname result-sorted-truenamestrings)
 123   "guts of NEED-MATCH"
 124   (let ((directory-sorted-truenamestrings (sorted-truenamestrings
 125                                            (directory directory-pathname))))
 126     (unless (equal directory-sorted-truenamestrings
 127                    result-sorted-truenamestrings)
 128       (format t "~&~@<DIRECTORY argument = ~_~2I~S~:>~%"
 129               directory-pathname)
 130       (format t "~&~@<DIRECTORY result = ~_~2I~S~:>~%"
 131               directory-sorted-truenamestrings)
 132       (format t "~&~@<expected result = ~_~2I~S.~:>~%"
 133               result-sorted-truenamestrings)
 134       (error "mismatch between DIRECTORY and expected result"))))
 135 (defun need-match (directory-pathname result-pathnames)
 136   "Require that (DIRECTORY DIRECTORY-PATHNAME) return RESULT-PATHNAMES
 137 (modulo TRUENAME and NAMESTRING applied to each RESULT-PATHNAME for
 138 convenience in e.g. converting Unix filename syntax idiosyncrasies to
 139 Lisp filename syntax idiosyncrasies)."
 140   (let ((sorted-result-truenamestrings (sorted-truenamestrings
 141                                         result-pathnames)))
 142   ;; Relative and absolute pathnames should give the same result.
 143   (need-match-1 directory-pathname
 144                 sorted-result-truenamestrings)
 145   (need-match-1 (absolutify directory-pathname)
 146                 sorted-result-truenamestrings)))
 147 (defun need-matches ()
 148   "lotso calls to NEED-MATCH"
 149   ;; FIXME: As discussed on sbcl-devel ca. 2001-01-01, DIRECTORY should
 150   ;; report Unix directory files contained within its output as e.g.
 151   ;; "/usr/bin" instead of the CMU-CL-style "/usr/bin/". In that case,
 152   ;; s:/":": in most or all the NEED-MATCHes here.
 153   (need-match "./*.*" '("animal/" "dirt" "plant/" "water"))
 154   (need-match "*.*" '("animal/" "dirt" "plant/" "water"))
 155   (need-match "animal" '("animal/"))
 156   (need-match "./animal" '("animal/"))
 157   (need-match "animal/*.*" '("animal/invertebrate/" "animal/vertebrate/"))
 158   (need-match "animal/*/*.*"
 159               '("animal/vertebrate/bird/"
 160                 "animal/vertebrate/mammal/"
 161                 "animal/vertebrate/snake/"))
 162   (need-match "plant/*.*" '("plant/kingsfoil" "plant/pipeweed"))
 163   (need-match "plant/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
 164   (need-match "plant/**/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
 165   (let ((vertebrates (mapcar (lambda (stem)
 166                                (concatenate 'string
 167                                             "animal/vertebrate/"
 168                                             stem))
 169                              '("bird/"
 170                                "mammal/"
 171                                "mammal/bear/" "mammal/bear/grizzly"
 172                                "mammal/mythical/" "mammal/mythical/mermaid"
 173                                "mammal/mythical/unicorn"
 174                                "mammal/platypus"
 175                                "mammal/rodent/" "mammal/rodent/beaver"
 176                                "mammal/rodent/mouse" "mammal/rodent/rabbit"
 177                                "mammal/rodent/rat"
 178                                "mammal/ruminant/" "mammal/ruminant/cow"
 179                                "mammal/walrus"
 180                                "snake/" "snake/python"))))
 181     (need-match "animal/vertebrate/**/*.*" vertebrates)
 182     (need-match "animal/vertebrate/mammal/../**/*.*" vertebrates)
 183     (need-match "animal/vertebrate/mammal/../**/**/*.*" vertebrates)
 184     #+nil
 185     (need-match "animal/vertebrate/mammal/mythical/../**/../**/*.*"
 186                 vertebrates))
 187   (need-match "animal/vertebrate/**/robot.*" nil)
 188   (need-match "animal/vertebrate/mammal/../**/*.robot" nil)
 189   (need-match "animal/vertebrate/mammal/../**/robot/*.*" nil)
 190   #+nil
 191   (need-match "animal/vertebrate/mammal/robot/../**/../**/*.*" nil))
 192 (need-matches)
 193 (sb-ext:quit :unix-status 52)
 194 EOF
 195 if [ $? != 52 ]; then
 196     echo DIRECTORY/TRUENAME test part 1 failed, unexpected SBCL return code=$?
 197     exit 1
 198 fi
 199 cd ..
 200 rm -r $testdir
 201
 202 # success convention for script
 203 exit 104