0.pre7.110:
authorWilliam Harold Newman <william.newman@airmail.net>
Tue, 1 Jan 2002 17:01:28 +0000 (17:01 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Tue, 1 Jan 2002 17:01:28 +0000 (17:01 +0000)
added tests for DIRECTORY on hierarchical directories

BUGS
TODO
tests/filesys.test.sh
version.lisp-expr

diff --git a/BUGS b/BUGS
index 6146de2..62ffc35 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -50,31 +50,33 @@ WORKAROUND:
   believers in ANSI compatibility and all, (1) there's no obvious
   simple way to do it (short of disabling all warnings for type
   mismatches everywhere), and (2) there's a good portable
-  workaround. ANSI justifies this specification by saying 
+  workaround, and (3) by their own reasoning, it looks as though
+  ANSI may have gotten it wrong. ANSI justifies this specification
+  by saying 
     The restriction against issuing a warning for type mismatches
     between a slot-initform and the corresponding slot's :TYPE
     option is necessary because a slot-initform must be specified
     in order to specify slot options; in some cases, no suitable
     default may exist.
-  In SBCL, as in CMU CL (or, for that matter, any compiler which
-  really understands Common Lisp types) a suitable default does
-  exist, in all cases, because the compiler understands the concept
-  of functions which never return (i.e. has return type NIL, e.g.
-  ERROR). Thus, as a portable workaround, you can use a call to
-  some known-never-to-return function as the default. E.g.
+  However, in SBCL (as in CMU CL or, for that matter, any compiler
+  which really understands Common Lisp types) a suitable default
+  does exist, in all cases, because the compiler understands the
+  concept of functions which never return (i.e. has return type NIL).
+  Thus, as a portable workaround, you can use a call to some
+  known-never-to-return function as the default. E.g.
     (DEFSTRUCT FOO
       (BAR (ERROR "missing :BAR argument")
            :TYPE SOME-TYPE-TOO-HAIRY-TO-CONSTRUCT-AN-INSTANCE-OF))
   or 
-    (DECLAIM (FTYPE () NIL) MISSING-ARG) 
+    (DECLAIM (FTYPE (FUNCTION () NIL) MISSING-ARG))
     (DEFUN REQUIRED-ARG () ; workaround for SBCL non-ANSI slot init typing
       (ERROR "missing required argument")) 
     (DEFSTRUCT FOO
       (BAR (REQUIRED-ARG) :TYPE TRICKY-TYPE-OF-SOME-SORT)
       (BLETCH (REQUIRED-ARG) :TYPE TRICKY-TYPE-OF-SOME-SORT)
       (N-REFS-SO-FAR 0 :TYPE (INTEGER 0)))
-  Such code will compile without complaint and work correctly either
-  on SBCL or on a completely compliant Common Lisp system.
+  Such code should compile without complaint and work correctly either
+  on SBCL or on any other completely compliant Common Lisp system.
 
 6:
   bogus warnings about undefined functions for magic functions like
@@ -1249,16 +1251,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   types manually, allowing the special case (VALUES) but still excluding
   all more-complex VALUES types.
 
-134:
-  (reported by Alexey Dejneka sbcl-devel 2001-12-07)
-    (let ((s '((1 2 3))))
-      (eval (eval ``(vector ,@',@s))))
-      
-    should return #(1 2 3), instead of this it causes a reader error.
-      
-    Interior call of BACKQUOTIFY erroneously optimizes ,@': it immediately
-    splices the temporal representation of ,@S.
-    
 135:
   Ideally, uninterning a symbol would allow it, and its associated
   FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, 
@@ -1281,40 +1273,14 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
 137:
   (SB-DEBUG:BACKTRACE) output should start with something
   including the name BACKTRACE, not (as in 0.pre7.88)
-  just "0: (\"hairy arg processor\" ...)". In general
-  the names in BACKTRACE are all screwed up compared to
-  the nice useful names in 0.6.13.
-
-  Note for those who observe that this is an annoying
-  bug and doesn't belong in a release: See the "note for the 
-  ambitious", below.
-
-  Note for the ambitious: This is an important bug and I'd
-  really like to fix it and spent many hours on it. The 
-  obvious ways to fix it are hard, because the underlying
-  infrastructure seems to be rather broken.
-  * There are two mostly-separate systems for storing names,
-    the in-the-function-object system used by e.g.
-    CL:FUNCTION-LAMBDA-EXPRESSION and the
-    in-the-DEBUG-FUN-object system used by e.g. BACKTRACE.
-    The code as of sbcl-0.pre7.94 is smart enough to set
-    up the first value, but not the second (because I naively
-    assumed that one mechanism is enough, and didn't proof
-    read the entire system to see whether there might be
-    another mechanism?! argh...)
-  * The systems are not quite separate, but instead weirdly and
-     fragilely coupled by the FUN-DEBUG-FUN algorithm.
-  * If you try to refactor this dain bramage away, reducing
-    things to a single system -- I tried to add a
-    %SIMPLE-FUN-DEBUG-FUN slot, planning eventually to get
-    rid of the old %SIMPLE-FUN-NAME slot in favor of indirection
-    through the new slot -- you get torpedoed by the fragility
-    of the SIMPLE-FUN primitive object. Just adding the
-    new slot, without making any other changes in the system,
-    is enough to make the system fail with what look like
-    memory corruption problems in warm init.
-  But please do fix some or all of the problem, I'm tired
-  of messing with it. -- WHN 2001-12-22
+  just "0: (\"hairy arg processor\" ...)". Until about
+  sbcl-0.pre7.109, the names in BACKTRACE were all screwed
+  up compared to the nice useful names in sbcl-0.6.13.
+  Around sbcl-0.pre7.109, they were mostly fixed by using
+  NAMED-LAMBDA to implement DEFUN. However, there are still
+  some screwups left, e.g. as of sbcl-0.pre7.109, there are
+  still some functions named "hairy arg processor" and
+  "SB-INT:&MORE processor".
 
 138:
   a cross-compiler bug in sbcl-0.pre7.107
diff --git a/TODO b/TODO
index 0c479a1..887dc4f 100644 (file)
--- a/TODO
+++ b/TODO
@@ -5,19 +5,17 @@ for 0.7.0:
        leaving some filing for later:-) from the monster
        EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup:
        ** made inlining DEFUN inside MACROLET work again
-       ** whatever bug it is that causes s/#'(lambda/(lambda/ to 
-               cause compilation failure in condition.lisp
-       ** perhaps function debug name quick fix, if there's an easy way
+       ** bug 138 
 * more renaming in global external names:
        ** reserved DO-FOO-style names for iteration macros
        ** finished s/FUNCTION/FUN/
        ** s/VARIABLE/VAR/
-       ** s/TOP-LEVEL/TOPLEVEL/
        ** perhaps s/DEF-FROB/DEF/ or s/DEF-FROB/DEFINE/
 * global style systematization:
        ** s/#'(lambda/(lambda/
 * pending patches and bug reports that go in (or else get handled
        somehow, rejected/logged/whatever) before 0.7.0:
+       ** DIRECTORY problems (bug 139, CR patch sbcl-devel 2001-12-31)
 =======================================================================
 for early 0.7.x:
 
index 37c0e0b..62f900a 100644 (file)
@@ -73,5 +73,124 @@ if [ $? != 52 ]; then
 fi
 rm -r $testdir
 
+# Test DIRECTORY on a tree structure of directories.
+mkdir $testdir
+cd $testdir
+touch water dirt
+mkdir animal plant
+mkdir animal/vertebrate animal/invertebrate
+mkdir animal/vertebrate/mammal
+mkdir animal/vertebrate/snake
+mkdir animal/vertebrate/bird
+mkdir animal/vertebrate/mammal/bear
+mkdir animal/vertebrate/mammal/mythical
+mkdir animal/vertebrate/mammal/rodent
+mkdir animal/vertebrate/mammal/ruminant
+touch animal/vertebrate/mammal/bear/grizzly
+touch animal/vertebrate/mammal/mythical/mermaid
+touch animal/vertebrate/mammal/mythical/unicorn
+touch animal/vertebrate/mammal/rodent/beaver
+touch animal/vertebrate/mammal/rodent/mouse
+touch animal/vertebrate/mammal/rodent/rabbit
+touch animal/vertebrate/mammal/rodent/rat
+touch animal/vertebrate/mammal/ruminant/cow
+touch animal/vertebrate/snake/python
+touch plant/kingsfoil plant/pipeweed
+$SBCL <<EOF
+(in-package :cl-user)
+(defun absolutify (pathname)
+  "Convert a possibly-relative pathname to absolute."
+  (merge-pathnames pathname
+                  (make-pathname :directory
+                                 (pathname-directory
+                                  *default-pathname-defaults*))))
+(defun sorted-truenamestrings (pathname-designators)
+  "Convert a collection of pathname designators into canonical form
+using TRUENAME, NAMESTRING, and SORT."
+  (sort (mapcar #'namestring
+               (mapcar #'truename
+                       pathname-designators))
+       #'string<))
+(defun need-match-1 (directory-pathname result-sorted-truenamestrings)
+  "guts of NEED-MATCH"
+  (let ((directory-sorted-truenamestrings (sorted-truenamestrings
+                                          (directory directory-pathname))))
+    (unless (equal directory-sorted-truenamestrings
+                  result-sorted-truenamestrings)
+      (format t "~&~@<DIRECTORY argument = ~_~2I~S~:>~%"
+             directory-pathname)
+      (format t "~&~@<DIRECTORY result = ~_~2I~S~:>~%"
+             directory-sorted-truenamestrings)
+      (format t "~&~@<expected result = ~_~2I~S.~:>~%"
+             result-sorted-truenamestrings)
+      (error "mismatch between DIRECTORY and expected result"))))
+(defun need-match (directory-pathname result-pathnames)
+  "Require that (DIRECTORY DIRECTORY-PATHNAME) return RESULT-PATHNAMES
+(modulo TRUENAME and NAMESTRING applied to each RESULT-PATHNAME for
+convenience in e.g. converting Unix filename syntax idiosyncrasies to
+Lisp filename syntax idiosyncrasies)."
+  (let ((sorted-result-truenamestrings (sorted-truenamestrings
+                                        result-pathnames)))
+  ;; Relative and absolute pathnames should give the same result.
+  (need-match-1 directory-pathname
+                sorted-result-truenamestrings)
+  (need-match-1 (absolutify directory-pathname)
+                sorted-result-truenamestrings)))
+(defun need-matches ()
+  "lotso calls to NEED-MATCH"
+  ;; FIXME: As discussed on sbcl-devel ca. 2001-01-01, DIRECTORY should
+  ;; report Unix directory files contained within its output as e.g.
+  ;; "/usr/bin" instead of the CMU-CL-style "/usr/bin/". In that case,
+  ;; s:/":": in most or all the NEED-MATCHes here.
+  (need-match "./*.*" '("animal/" "dirt" "plant/" "water"))
+  ;; FIXME: (DIRECTORY "*.*") doesn't work (bug 139). And it looks as
+  ;; though the same problem affects (DIRECTORY "animal") too.
+  #+nil (need-match "*.*" '("animal/" "dirt" "plant/" "water"))
+  #+nil (need-match "animal" '("animal/"))
+  (need-match "./animal" '("animal/"))
+  (need-match "animal/*.*" '("animal/invertebrate/" "animal/vertebrate/"))
+  (need-match "animal/*/*.*"
+             '("animal/vertebrate/bird/"
+               "animal/vertebrate/mammal/"
+               "animal/vertebrate/snake/"))
+  (need-match "plant/*.*" '("plant/kingsfoil" "plant/pipeweed"))
+  (need-match "plant/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
+  (need-match "plant/**/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
+  (let ((vertebrates (mapcar (lambda (stem)
+                              (concatenate 'string
+                                           "animal/vertebrate/"
+                                           stem))
+                            '("bird/"
+                              "mammal/"
+                              "mammal/bear/" "mammal/bear/grizzly"
+                              "mammal/mythical/" "mammal/mythical/mermaid"
+                              "mammal/mythical/unicorn"
+                              "mammal/platypus"
+                              "mammal/rodent/" "mammal/rodent/beaver"
+                              "mammal/rodent/mouse" "mammal/rodent/rabbit"
+                              "mammal/rodent/rat"
+                              "mammal/ruminant/" "mammal/ruminant/cow"
+                              "mammal/walrus"
+                              "snake/" "snake/python"))))
+    (need-match "animal/vertebrate/**/*.*" vertebrates)
+    ;; FIXME: In sbcl-0.pre7.109, DIRECTORY got confused on (I think...)
+    ;; absolute pathnames containing "../*" stuff. If I understood
+    ;; and remember correctly, CR's patch will fix this.
+    #|
+    (need-match "animal/vertebrate/mammal/../**/*.*" vertebrates)
+    (need-match "animal/vertebrate/mammal/../**/**/*.*" vertebrates)
+    (need-match "animal/vertebrate/mammal/mythical/../**/../**/*.*"
+               vertebrates)
+    |#
+    )
+  (need-match "animal/vertebrate/**/robot.*" nil)
+  (need-match "animal/vertebrate/mammal/../**/*.robot" nil)
+  (need-match "animal/vertebrate/mammal/../**/robot/*.*" nil)
+  (need-match "animal/vertebrate/mammal/robot/../**/../**/*.*" nil))
+(need-matches)
+EOF
+cd ..
+rm -r $testdir
+
 # success convention for script
 exit 104
index 9f803cf..c04d70c 100644 (file)
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.109"
+"0.pre7.110"