Skip to content

Commit

Permalink
0.pre7.110:
Browse files Browse the repository at this point in the history
	added tests for DIRECTORY on hierarchical directories
  • Loading branch information
William Harold Newman committed Jan 1, 2002
1 parent 90ca09b commit c1aeac1
Show file tree
Hide file tree
Showing 4 changed files with 142 additions and 59 deletions.
74 changes: 20 additions & 54 deletions BUGS
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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
Expand Down
6 changes: 2 additions & 4 deletions TODO
Expand Up @@ -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:

Expand Down
119 changes: 119 additions & 0 deletions tests/filesys.test.sh
Expand Up @@ -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
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit c1aeac1

Please sign in to comment.