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