[Git][cmucl/cmucl][issue-120-software-type-in-c] 13 commits: Fix #157: (directory "**/") only returns directories

Raymond Toy (@rtoy) gitlab at common-lisp.net
Wed Mar 22 18:04:00 UTC 2023



Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl


Commits:
b3de9354 by Raymond Toy at 2023-03-09T14:46:48+00:00
Fix #157: (directory "**/") only returns directories

- - - - -
39e30fad by Raymond Toy at 2023-03-09T14:46:48+00:00
Merge branch 'issue-157-directory-no-magic-wildcarding' into 'master'

Fix #157: (directory "**/") only returns directories

Closes #157

See merge request cmucl/cmucl!127
- - - - -
0038d3d9 by Raymond Toy at 2023-03-09T11:18:21-08:00
Update release notes with recently closed bugs

- - - - -
d51eb4b8 by Raymond Toy at 2023-03-12T19:05:39+00:00
Fix #175: Simplify branching in x86 float compare vops

- - - - -
a7237e1d by Raymond Toy at 2023-03-12T19:05:39+00:00
Merge branch 'issue-175-simplify-float-compare-vops' into 'master'

Fix #175: Simplify branching in x86 float compare vops

Closes #175

See merge request cmucl/cmucl!129
- - - - -
6b28a906 by Raymond Toy at 2023-03-15T14:06:28+00:00
Fix #177: Add pprinter for deftransform and defoptimizer

- - - - -
75e0b7e3 by Raymond Toy at 2023-03-15T14:06:31+00:00
Merge branch 'issue-177-pprint-deftransform' into 'master'

Fix #177: Add pprinter for deftransform and defoptimizer

Closes #177

See merge request cmucl/cmucl!132
- - - - -
6b3ceb28 by Raymond Toy at 2023-03-16T17:08:32+00:00
Fix #172: Declare pathname-match-p to return NIL or a pathname

- - - - -
0b9e41a4 by Raymond Toy at 2023-03-16T17:08:35+00:00
Merge branch 'issue-172-pathname-match-p-return-type' into 'master'

Fix #172: Declare pathname-match-p to return NIL or a pathname

Closes #172

See merge request cmucl/cmucl!131
- - - - -
b329b385 by Raymond Toy at 2023-03-16T10:18:39-07:00
Fix some typos

- - - - -
4b75969a by Raymond Toy at 2023-03-16T10:42:53-07:00
Address #120: Move misc doc stuff to misc-doc.lisp

As mentioned in
https://gitlab.common-lisp.net/cmucl/cmucl/-/merge_requests/93#note_11267,
this moves some parts of misc.lisp to misc-doc.lisp that is needed to
implement #120.

- - - - -
6751cc90 by Raymond Toy at 2023-03-16T12:18:09-07:00
Add new file misc-doc.lisp

Forgot to chech this in.

- - - - -
e7fc70da by Raymond Toy at 2023-03-22T10:42:08-07:00
Merge branch 'issue-120-move-misc-first' into issue-120-software-type-in-c

- - - - -


8 changed files:

- src/code/filesys.lisp
- src/code/misc.lisp
- src/code/pprint.lisp
- src/compiler/fndb.lisp
- src/compiler/x86/float-sse2.lisp
- src/general-info/release-21e.md
- + tests/nan.lisp
- tests/pathname.lisp


Changes:

=====================================
src/code/filesys.lisp
=====================================
@@ -1122,11 +1122,7 @@ optionally keeping some of the most recent old versions."
     (let ((results nil))
       (enumerate-search-list
 	  (pathname (merge-pathnames pathname
-				     (make-pathname :name :wild
-						    :type :wild
-						    :version :wild
-						    :defaults *default-pathname-defaults*)
-				     :wild))
+				     *default-pathname-defaults*))
 	(enumerate-matches (name pathname nil :follow-links follow-links)
 	  (when (or all
 		    (let ((slash (position #\/ name :from-end t)))


=====================================
src/code/misc.lisp
=====================================
@@ -30,109 +30,6 @@
 
 (in-package "LISP")
 
-;;; cobbled from stuff in describe.lisp.
-(defun function-doc (x)
-  (let ((name
-	 (case (kernel:get-type x)
-	   (#.vm:closure-header-type
-	    (kernel:%function-name (%closure-function x)))
-	   ((#.vm:function-header-type #.vm:closure-function-header-type)
-	    (kernel:%function-name x))
-	   (#.vm:funcallable-instance-header-type
-	    (typecase x
-	      (kernel:byte-function
-	       (c::byte-function-name x))
-	      (kernel:byte-closure
-	       (c::byte-function-name (byte-closure-function x)))
-	      (eval:interpreted-function
-	       (multiple-value-bind 
-		     (exp closure-p dname)
-		   (eval:interpreted-function-lambda-expression x)
-		 (declare (ignore exp closure-p))
-		 dname))
-	      (t ;; funcallable-instance
-	       (kernel:%function-name
-		(kernel:funcallable-instance-function x))))))))
-    (when (and name (typep name '(or symbol cons)))
-      (values (info function documentation name)))))
-
-(defun documentation (x doc-type)
-  "Returns the documentation string of Doc-Type for X, or NIL if
-  none exists.  System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,
-  SETF, and T."
-  (flet (;; CMUCL random-documentation.
-	 (try-cmucl-random-doc (x doc-type)
-	   (declare (symbol doc-type))
-	   (cdr (assoc doc-type
-		       (values (info random-documentation stuff x))))))
-    (case doc-type
-      (variable 
-       (typecase x
-	 (symbol (values (info variable documentation x)))))
-      (function
-       (typecase x
-	 (symbol (values (info function documentation x)))
-	 (function (function-doc x))
-	 (list ;; Must be '(setf symbol)
-	  (values (info function documentation (cadr x))))))
-      (structure
-       (typecase x
-	 (symbol (when (eq (info type kind x) :instance)
-		   (values (info type documentation x))))))
-      (type
-       (typecase x
-	 (kernel::structure-class (values (info type documentation (%class-name x))))
-	 (t (and (typep x 'symbol) (values (info type documentation x))))))
-      (setf (info setf documentation x))
-      ((t)
-       (typecase x
-	 (function (function-doc x))
-	 (package (package-doc-string x))
-	 (kernel::structure-class (values (info type documentation (%class-name x))))
-	 (symbol (try-cmucl-random-doc x doc-type))))
-      (t
-       (typecase x
-	 (symbol (try-cmucl-random-doc x doc-type)))))))
-
-(defun (setf documentation) (string name doc-type)
-  #-no-docstrings
-  (case doc-type
-    (variable
-     #+nil
-     (when string
-       (%primitive print "Set variable text domain")
-       (%primitive print (symbol-name name))
-       (%primitive print intl::*default-domain*))
-     (setf (info variable textdomain name) intl::*default-domain*)
-     (setf (info variable documentation name) string))
-    (function
-     #+nil
-     (when intl::*default-domain*
-       (%primitive print "Set function text domain")
-       (%primitive print (symbol-name name))
-       (%primitive print intl::*default-domain*))
-     (setf (info function textdomain name) intl::*default-domain*)
-     (setf (info function documentation name) string))
-    (structure
-     (unless (eq (info type kind name) :instance)
-       (error (intl:gettext "~S is not the name of a structure type.") name))
-     (setf (info type textdomain name) intl::*default-domain*)
-     (setf (info type documentation name) string))
-    (type
-     (setf (info type textdomain name) intl::*default-domain*)
-     (setf (info type documentation name) string))
-    (setf
-     (setf (info setf textdomain name) intl::*default-domain*)
-     (setf (info setf documentation name) string))
-    (t
-     (let ((pair (assoc doc-type (info random-documentation stuff name))))
-       (if pair
-	   (setf (cdr pair) string)
-	   (push (cons doc-type string)
-		 (info random-documentation stuff name))))))
-  string)
-
-
 ;;; Register various Lisp features
 #+sparc-v7
 (sys:register-lisp-runtime-feature :sparc-v7)


=====================================
src/code/pprint.lisp
=====================================
@@ -2074,7 +2074,9 @@ When annotations are present, invoke them at the right positions."
     (lisp::with-array-data pprint-with-like)
     (c:define-vop pprint-define-vop)
     (c:sc-case pprint-sc-case)
-    (c:define-assembly-routine pprint-define-assembly)))
+    (c:define-assembly-routine pprint-define-assembly)
+    (c:deftransform pprint-defun)
+    (c:defoptimizer pprint-defun)))
 
 (defun pprint-init ()
   (setf *initial-pprint-dispatch* (make-pprint-dispatch-table))


=====================================
src/compiler/fndb.lisp
=====================================
@@ -1027,7 +1027,10 @@
 							  :type :version))
   boolean
   (flushable))
-(defknown pathname-match-p (pathnamelike pathnamelike) boolean
+(defknown pathname-match-p (pathnamelike pathnamelike)
+  ;; CLHS says the return type is a generalized boolean.  We currently
+  ;; return a pathname on a match.
+  (or null pathname)
   (flushable))
 (defknown translate-pathname (pathnamelike pathnamelike pathnamelike &key)
   pathname


=====================================
src/compiler/x86/float-sse2.lisp
=====================================
@@ -945,7 +945,7 @@
   (frob double ucomisd))
 
 (macrolet
-    ((frob (op size inst yep nope)
+    ((frob (op size inst)
        (let ((ea (ecase size
 		   (single
 		    'ea-for-sf-desc)
@@ -953,28 +953,52 @@
 		    'ea-for-df-desc)))
 	     (name (symbolicate op "/" size "-FLOAT"))
 	     (sc-type (symbolicate size "-REG"))
-	     (inherit (symbolicate size "-FLOAT-COMPARE")))
+	     (inherit (symbolicate size "-FLOAT-COMPARE"))
+	     (reverse-args-p (eq op '<)))
 	 `(define-vop (,name ,inherit)
+	    ;; The compare instructions take a reg argument for the
+	    ;; first arg and reg or mem argument for the second.  When
+	    ;; inverting the arguments we must also invert which of
+	    ;; the argument can be a mem argument.
+	    (:args (x :scs (,sc-type ,@(when reverse-args-p 'descriptor-reg)))
+		   (y :scs (,sc-type ,@(unless reverse-args-p 'descriptor-reg))))
 	    (:translate ,op)
 	    (:info target not-p)
 	    (:generator 3
-	      (sc-case y
-		(,sc-type
-		 (inst ,inst x y))
-		(descriptor-reg
-		 (inst ,inst x (,ea y))))
-	      (cond (not-p
-		     (inst jmp :p target)
-		     (inst jmp ,nope target))
-		    (t
-		     (let ((not-lab (gen-label)))
-		       (inst jmp :p not-lab)
-		       (inst jmp ,yep target)
-		       (emit-label not-lab)))))))))
-  (frob < single comiss :b :nb)
-  (frob > single comiss :a :na)
-  (frob < double comisd :b :nb)
-  (frob > double comisd :a :na))
+	      ;; Note: x < y is the same as y > x.  We reverse the
+	      ;; args to reduce the number of jump instructions
+	      ;; needed.
+	      ,(if reverse-args-p
+		   `(sc-case x
+		      (,sc-type
+		       (inst ,inst y x))
+		      (descriptor-reg
+		       (inst ,inst y (,ea x))))
+		   `(sc-case y
+		      (,sc-type
+		       (inst ,inst x y))
+		      (descriptor-reg
+		       (inst ,inst x (,ea y)))))
+	      ;; Consider the case of x > y.
+	      ;;
+	      ;; When a NaN occurs, comis sets ZF, PF, and CF = 1.  In
+	      ;; the normal case (not-p false), we want to jump to the
+	      ;; target when x > y.  This happens when CF = 0.  Hence,
+	      ;; we won't jump to the target when there's a NaN, as
+	      ;; desired.
+	      ;;
+	      ;; For the not-p case, we want to jump to target when x
+	      ;; <= y.  This means CF = 1 or ZF = 1.  But NaN sets
+	      ;; these bits too, so we jump to the target for NaN or x
+	      ;; <= y, as desired.
+	      ;;
+	      ;; For the case of x < y, we can use the equivalent y >
+	      ;; x.  Thus if we swap the args, the same logic applies.
+	      (inst jmp (if (not not-p) :a :be) target))))))
+  (frob > single comiss)
+  (frob > double comisd)
+  (frob < single comiss)
+  (frob < double comisd))
 
 
 ;;;; Conversion:


=====================================
src/general-info/release-21e.md
=====================================
@@ -57,7 +57,7 @@ public domain.
     * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid.
     * ~~#128~~ `QUIT` accepts an exit code
     * ~~#130~~ Move file-author to C 
-    * ~~#132~~ Ansi test `RENAME-FILE.1` no fails
+    * ~~#132~~ Ansi test `RENAME-FILE.1` no longer fails
     * ~~#134~~ Handle the case of `(expt complex complex-rational)`
     * ~~#136~~ `ensure-directories-exist` should return the given pathspec
     * #139 `*default-external-format*` defaults to `:utf-8`; add alias for `:locale` external format
@@ -66,7 +66,18 @@ public domain.
     * ~~#142~~ `(random 0)` signals incorrect error
     * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
     * ~~#149~~ Call setlocale(3C) on startup
+    * ~~#150~~ Add aliases for external format cp949 and euckr
+    * ~~#151~~ Change `*default-external-format*` to `:utf-8`.
     * ~~#155~~ Wrap help strings neatly
+    * ~~#157~~ `(directory "foo/**/")` only returns directories now
+    * ~~#163~~ Add command-line option `-version` and `--version` to get lisp version
+    * ~~#165~~ Avoid inserting NIL into simple `LOOP` from `FORMAT`
+    * ~~#166~~ Fix incorrect type declaration for exponent from `integer-decode-float`
+    * ~~#167~~ Low bound for `decode-float-exponent` type was off by one.
+    * ~~#168~~ Don't use negated forms for jmp instructions when possible
+    * ~~#169~~ Add pprinter for `define-vop` and `sc-case`
+    * ~~#172~~ Declare `pathname-match-p` as returning `nil` or `pathname`.
+    * ~~#173~~ Add pprinter for `define-assembly-routine`
   * Other changes:
   * Improvements to the PCL implementation of CLOS:
   * Changes to building procedure:


=====================================
tests/nan.lisp
=====================================
@@ -0,0 +1,209 @@
+;;; Tests for NaN comparisons.
+(defpackage :nan-tests
+  (:use :cl :lisp-unit))
+
+(in-package :nan-tests)
+
+(defparameter *single-float-nan*
+  (ext:with-float-traps-masked (:invalid :divide-by-zero)
+    (/ 0d0 0d0)))
+
+(defparameter *double-float-nan*
+  (ext:with-float-traps-masked (:invalid :divide-by-zero)
+    (/ 0d0 0d0)))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (macrolet
+      ((frob (ntype op)
+	 (let* ((name (ext:symbolicate (if (eq ntype 'single-float)
+					   "S"
+					   "D")
+				       "TST-" op))
+		(name3 (ext:symbolicate name "3")))
+
+	   `(progn
+	      (defun ,name (x y)
+		(declare (,ntype x y))
+		(,op x y))
+	      (defun ,name3 (x y z)
+		(declare (,ntype x y z))
+		(,op x y z))))))
+    (frob single-float <)
+    (frob single-float >)
+    (frob double-float <)
+    (frob double-float >)
+    (frob single-float =)
+    (frob double-float =)))
+
+(define-test nan-single.<
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (stst-< 1f0 2f0))
+  (assert-false (stst-< 1f0 1f0))
+  (assert-false (stst-< 1f0 0f0))
+  ;; Now try NaN.  All comparisons should be false.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-< *single-float-nan* 1f0))
+    (assert-false (stst-< 1f0 *single-float-nan*))
+    (assert-false (stst-< *single-float-nan* *single-float-nan*))))
+
+(define-test nan-double.<
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (dtst-< 1d0 2d0))
+  (assert-false (dtst-< 1d0 1d0))
+  (assert-false (dtst-< 1d0 0d0))
+  ;; Now try NaN.  All comparisons should be false.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-< *double-float-nan* 1d0))
+    (assert-false (dtst-< 1d0 *double-float-nan*))
+    (assert-false (dtst-< *double-float-nan* *double-float-nan*))))
+
+(define-test nan-single.>
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (stst-> 2f0 1f0))
+  (assert-false (stst-> 1f0 1f0))
+  (assert-false (stst-> 0f0 1f0))
+  ;; Now try NaN.  All comparisons should be false.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-> *single-float-nan* 1f0))
+    (assert-false (stst-> 1f0 *single-float-nan*))
+    (assert-false (stst-> *single-float-nan* *single-float-nan*))))
+
+(define-test nan-double.>
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (dtst-> 2d0 1d0))
+  (assert-false (dtst-> 1d0 1d0))
+  (assert-false (dtst-> 0d0 1d0))
+  ;; Now try NaN.  All comparisons should be false.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-> *double-float-nan* 1d0))
+    (assert-false (dtst-> 1d0 *double-float-nan*))
+    (assert-false (dtst-> *double-float-nan* *double-float-nan*))))
+
+(define-test nan-single.<3
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (stst-<3 1f0 2f0 3f0))
+  (assert-false (stst-<3 1f0 2f0 2f0))
+  (assert-false (stst-<3 1f0 1f0 2f0))
+  (assert-false (stst-<3 1f0 0f0 2f0))
+  ;; Now try NaN.  Currently we can only test if there's NaN in the
+  ;; first two args.  When NaN is the last arg, we return the
+  ;; incorrect value because of how multi-compare converts multiple
+  ;; args into paris of comparisons.
+  ;;
+  ;; When that is fixed, we can add additional tests.  Nevertheless,
+  ;; this is useful because it tests the not-p case of the vops.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-<3 *single-float-nan* 2f0 3f0))
+    (assert-false (stst-<3 1f0 *single-float-nan* 3f0))
+    (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0))))
+  
+(define-test nan-double.<3
+    (:tag :nan)
+  ;; First just make sure it works with regular double-floats
+  (assert-true (dtst-<3 1d0 2d0 3d0))
+  (assert-false (dtst-<3 1d0 2d0 2d0))
+  (assert-false (dtst-<3 1d0 1d0 2d0))
+  (assert-false (dtst-<3 1d0 0d0 2d0))
+  ;; Now try NaN.  Currently we can only test if there's NaN in the
+  ;; first two args.  When NaN is the last arg, we return the
+  ;; incorrect value because of how multi-compare converts multiple
+  ;; args into paris of comparisons.
+  ;;
+  ;; When that is fixed, we can add additional tests.  Nevertheless,
+  ;; this is useful because it tests the not-p case of the vops.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-<3 *double-float-nan* 2d0 3d0))
+    (assert-false (dtst-<3 1d0 *double-float-nan* 3d0))
+    (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0))))
+  
+(define-test nan-single.>3
+    (:tag :nan)
+  ;; First just make sure it works with regular single-floats
+  (assert-true (stst->3 3f0 2f0 1f0))
+  (assert-false (stst->3 3f0 1f0 1f0))
+  (assert-false (stst->3 2f0 2f0 1f0))
+  (assert-false (stst->3 0f0 2f0 1f0))
+  ;; Now try NaN.  Currently we can only test if there's NaN in the
+  ;; first two args.  When NaN is the last arg, we return the
+  ;; incorrect value because of how multi-compare converts multiple
+  ;; args into paris of comparisons.
+  ;;
+  ;; When that is fixed, we can add additional tests.  Nevertheless,
+  ;; this is useful because it tests the not-p case of the vops.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst->3 *single-float-nan* 2f0 3f0))
+    (assert-false (stst->3 1f0 *single-float-nan* 3f0))
+    (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0))))
+  
+(define-test nan-double.>3
+    (:tag :nan)
+  ;; First just make sure it works with regular double-floats
+  (assert-true (dtst->3 3d0 2d0 1d0))
+  (assert-false (dtst->3 3d0 1d0 1d0))
+  (assert-false (dtst->3 2d0 2d0 1d0))
+  (assert-false (dtst->3 0d0 2d0 1d0))
+  ;; Now try NaN.  Currently we can only test if there's NaN in the
+  ;; first two args.  When NaN is the last arg, we return the
+  ;; incorrect value because of how multi-compare converts multiple
+  ;; args into paris of comparisons.
+  ;;
+  ;; When that is fixed, we can add additional tests.  Nevertheless,
+  ;; this is useful because it tests the not-p case of the vops.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst->3 *double-float-nan* 2d0 3d0))
+    (assert-false (dtst->3 1d0 *double-float-nan* 3d0))
+    (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0))))
+  
+(define-test nan-single.=
+    (:tag :nan)
+  ;; Basic tests with regular numbers.
+  (assert-true (stst-= 1f0 1f0))
+  (assert-false (stst-= 2f0 1f0))
+  (assert-false (stst-= 0f0 1f0))
+  ;; Tests with NaN, where = should fail.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-= *single-float-nan* 1f0))
+    (assert-false (stst-= 1f0 *single-float-nan*))
+    (assert-false (stst-= *single-float-nan* *single-float-nan*))))
+
+(define-test nan-double.=
+    (:tag :nan)
+  ;; Basic tests with regular numbers.
+  (assert-true (stst-= 1d0 1d0))
+  (assert-false (stst-= 2d0 1d0))
+  (assert-false (stst-= 0d0 1d0))
+  ;; Tests with NaN, where = should fail.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-= *double-float-nan* 1d0))
+    (assert-false (stst-= 1d0 *double-float-nan*))
+    (assert-false (stst-= *double-float-nan* *double-float-nan*))))
+  
+(define-test nan-single.=3
+    (:tag :nan)
+  ;; Basic tests with regular numbers.
+  (assert-true (stst-=3 1f0 1f0 1f0))
+  (assert-false (stst-=3 1f0 1f0 0f0))
+  (assert-false (stst-=3 0f0 1f0 1f0))
+  ;; Tests with NaN, where = should fail.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-=3 *single-float-nan* 1f0 1f0))
+    (assert-false (stst-=3 1f0 *single-float-nan* 1f0))
+    (assert-false (stst-=3 1f0 1f0 *single-float-nan*))))
+
+(define-test nan-double.=3
+    (:tag :nan)
+  ;; Basic tests with regular numbers.
+  (assert-true (dtst-=3 1d0 1d0 1d0))
+  (assert-false (dtst-=3 1d0 1d0 0d0))
+  (assert-false (dtst-=3 0d0 1d0 1d0))
+  ;; Tests with NaN, where = should fail.
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-=3 *double-float-nan* 1d0 1d0))
+    (assert-false (dtst-=3 1d0 *double-float-nan* 1d0))
+    (assert-false (dtst-=3 1d0 1d0 *double-float-nan*))))


=====================================
tests/pathname.lisp
=====================================
@@ -72,4 +72,14 @@
 			       :directory '(:absolute "system2" "module4")
 			       :name nil :type nil)
 		(parse-namestring "ASDFTEST:system2;module4;"))))
-  
+
+
+
+(define-test directory.dirs
+  (let ((files (directory "src/assembly/**/")))
+    ;; Verify that we only returned directories
+    (loop for f in files
+	  for name = (pathname-name f)
+	  and type = (pathname-type f)
+	  do
+	     (assert-true (and (null name) (null type)) f))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e59b0b21eabe3bf27347bf8ea427e5c19c8a740...e7fc70da2269c8fcbf960d3410fe5e99e0b92df7

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e59b0b21eabe3bf27347bf8ea427e5c19c8a740...e7fc70da2269c8fcbf960d3410fe5e99e0b92df7
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230322/ba7d6836/attachment-0001.html>


More information about the cmucl-cvs mailing list