December 2023 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new branch issue-260-hemlock-in-core-for-options
by Raymond Toy (＠rtoy) 26 Dec '23

26 Dec '23

Raymond Toy pushed new branch issue-260-hemlock-in-core-for-options at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-260-hemlock-in-core… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Add some Gray stream extensions
by Raymond Toy (＠rtoy) 15 Dec '23

15 Dec '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0f7c45bf by Tarn Burton at 2023-12-15T17:05:47+00:00 Add some Gray stream extensions - - - - - c59d4284 by Raymond Toy at 2023-12-15T17:05:55+00:00 Merge branch 'gray' into 'master' Add some Gray stream extensions See merge request cmucl/cmucl!181 - - - - - 3 changed files: - src/i18n/locale/cmucl.pot - src/pcl/gray-streams-class.lisp - src/pcl/gray-streams.lisp Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -21155,6 +21155,13 @@ msgid "" " which returns CHARACTER." msgstr "" +#: src/pcl/gray-streams.lisp +msgid "" +"Set the type specifier of the kind of object returned by the\n" +" STREAM. There is no default method as this is optional and only\n" +" needed for bivalent streams." +msgstr "" + #: src/pcl/gray-streams.lisp msgid "" "Return true if Stream is not closed. A default method is provided\n" @@ -21169,6 +21176,17 @@ msgid "" " to clean up the side effects of having created the stream." msgstr "" +#: src/pcl/gray-streams.lisp +msgid "Convert pathspec (a pathname, string or stream) into a pathname." +msgstr "" + +#: src/pcl/gray-streams.lisp +msgid "" +"Return the pathname for the actual file described by the filespec.\n" +" An error of type file-error is signalled if no such file exists,\n" +" or the pathname is wild." +msgstr "" + #: src/pcl/gray-streams.lisp msgid "" "This reads one character from the stream. It returns either a\n" ===================================== src/pcl/gray-streams-class.lisp ===================================== @@ -21,7 +21,9 @@ ;;; Bootstrap the fundamental-stream class. (let ((pcl::*pcl-class-boot* 'fundamental-stream)) (defclass fundamental-stream (standard-object stream) - () + ((open-p + :initform t + :accessor stream-open-p)) (:documentation "Base class for all CLOS streams"))) ;;; Define the stream classes. ===================================== src/pcl/gray-streams.lisp ===================================== @@ -26,6 +26,12 @@ Stream. Class FUNDAMENTAL-CHARACTER-STREAM provides a default method which returns CHARACTER.")) +(defgeneric (setf stream-element-type) (new-value stream) + (:documentation + _N"Set the type specifier of the kind of object returned by the + STREAM. There is no default method as this is optional and only + needed for bivalent streams.")) + (defmethod stream-element-type ((stream lisp-stream)) (funcall (lisp-stream-misc stream) stream :element-type)) @@ -48,7 +54,7 @@ (not (eq (lisp-stream-in stream) #'closed-flame))) (defmethod pcl-open-stream-p ((stream fundamental-stream)) - nil) + (stream-open-p stream)) (when (find-class 'stream:simple-stream nil) (defmethod pcl-open-stream-p ((stream stream:simple-stream)) @@ -71,6 +77,11 @@ (funcall (lisp-stream-misc stream) stream :close abort)) t) +(defmethod pcl-close ((stream fundamental-stream) &key abort) + (declare (ignore abort)) + (setf (stream-open-p stream) nil) + t) + (when (find-class 'stream:simple-stream nil) (defmethod pcl-close ((stream stream:simple-stream) &key abort) (stream:device-close stream abort))) @@ -85,6 +96,10 @@ (defgeneric input-stream-p (stream) (:documentation _N"Returns non-nil if the given Stream can perform input operations.")) +(defmethod input-stream-p (stream) + (declare (ignore stream)) + nil) + (defmethod input-stream-p ((stream lisp-stream)) (and (not (eq (lisp-stream-in stream) #'closed-flame)) (or (not (eq (lisp-stream-in stream) #'ill-in)) @@ -105,6 +120,10 @@ (defgeneric output-stream-p (stream) (:documentation _N"Returns non-nil if the given Stream can perform output operations.")) +(defmethod output-stream-p (stream) + (declare (ignore stream)) + nil) + (defmethod output-stream-p ((stream lisp-stream)) (and (not (eq (lisp-stream-in stream) #'closed-flame)) (or (not (eq (lisp-stream-out stream) #'ill-out)) @@ -117,6 +136,30 @@ (defmethod output-stream-p ((stream stream:simple-stream)) (stream::%output-stream-p stream))) + + +(defgeneric pcl-pathname (pathspec) + (:documentation _N"Convert pathspec (a pathname, string or stream) into a pathname.")) + +(let ((func #'pathname)) + (defmethod pcl-pathname (pathspec) + (funcall func pathspec))) + +(setf (fdefinition 'pathname) #'pcl-pathname) + + + +(defgeneric pcl-truename (filespec) + (:documentation _N"Return the pathname for the actual file described by the filespec. + An error of type file-error is signalled if no such file exists, + or the pathname is wild.")) + +(let ((func #'truename)) + (defmethod pcl-truename (filespec) + (funcall func filespec))) + +(setf (fdefinition 'truename) #'pcl-truename) + ;;; Character input streams. ;;; @@ -205,13 +248,43 @@ _N"Implements CLEAR-INPUT for the stream, returning NIL. The default method does nothing.")) -(defmethod stream-clear-input ((stream fundamental-character-input-stream)) +(defmethod stream-clear-input ((stream fundamental-input-stream)) nil) (defgeneric stream-read-sequence (stream seq &optional start end) (:documentation _N"Implements READ-SEQUENCE for the stream.")) +(defmethod stream-read-sequence + ((stream fundamental-character-input-stream) sequence &optional start end) + (prog ((pos (or start 0)) + (end (or end (length sequence))) + value) + (declare (fixnum pos end)) + next + (when (< pos end) + (setf value (stream-read-char stream)) + (unless (eq value :eof) + (setf (elt sequence pos) value) + (incf pos) + (go next))) + (return pos))) + +(defmethod stream-read-sequence + ((stream fundamental-binary-input-stream) sequence &optional start end) + (prog ((pos (or start 0)) + (end (or end (length sequence))) + value) + (declare (fixnum pos end)) + next + (when (< pos end) + (setf value (stream-read-byte stream)) + (unless (eq value :eof) + (setf (elt sequence pos) value) + (incf pos) + (go next))) + (return pos))) + ;;; Character output streams. ;;; @@ -350,6 +423,30 @@ (:documentation _N"Implements WRITE-SEQUENCE for the stream.")) +(defmethod stream-write-sequence + ((stream fundamental-character-output-stream) sequence &optional start end) + (prog ((pos (or start 0)) + (end (or end (length sequence)))) + (declare (fixnum pos end)) + next + (when (< pos end) + (stream-write-char stream (elt sequence pos)) + (incf pos) + (go next))) + sequence) + +(defmethod stream-write-sequence + ((stream fundamental-binary-output-stream) sequence &optional start end) + (prog ((pos (or start 0)) + (end (or end (length sequence)))) + (declare (fixnum pos end)) + next + (when (< pos end) + (stream-write-byte stream (elt sequence pos)) + (incf pos) + (go next))) + sequence) + (defgeneric stream-file-position (stream) (:documentation _N"Implements FILE-POSITION for the stream.")) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b0fc47bd07ea5a0035f11c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b0fc47bd07ea5a0035f11c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Fix typo in -B option
by Raymond Toy (＠rtoy) 08 Dec '23

08 Dec '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: caf77e6f by Raymond Toy at 2023-12-08T15:54:45-08:00 Fix typo in -B option The bootfile is named boot-2023-08-1, not 2023-08-1. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "-B boot-2023-08 -B 2023-08-1" + bootstrap: "-B boot-2023-08 -B boot-2023-08-1" stages: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/caf77e6f2ffaf314b293144… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/caf77e6f2ffaf314b293144… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Update to current HEAD
by Raymond Toy (＠rtoy) 08 Dec '23

08 Dec '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: a886eca5 by Raymond Toy at 2023-12-08T15:49:42-08:00 Update to current HEAD Update .gitlab-ci.yml to use the bootstrap file for this change. Move the bootstrap from 21d to 21e and rename it appropriately to show what the snapshot is needed to build this. - - - - - 2 changed files: - .gitlab-ci.yml - src/bootfiles/21d/boot-2021-07-3.lisp → src/bootfiles/21e/boot-2023-08-1.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "-B boot-2023-08" + bootstrap: "-B boot-2023-08 -B 2023-08-1" stages: ===================================== src/bootfiles/21d/boot-2021-07-3.lisp → src/bootfiles/21e/boot-2023-08-1.lisp ===================================== View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a886eca53758acba9dd23c6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a886eca53758acba9dd23c6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] 65 commits: Set LANG in build.sh
by Raymond Toy (＠rtoy) 08 Dec '23

08 Dec '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: 4e433b83 by Raymond Toy at 2023-07-05T06:40:08-07:00 Set LANG in build.sh For some reason, on my Mac system, LANG isn't set and sometimes git messages are in Korean. So for consistency, set LANG in build.sh to a known value that should work everywhere. - - - - - da69492b by Raymond Toy at 2023-07-17T15:07:01+00:00 Fix #234: Make :ascii external format builtin. - - - - - 635d07ca by Raymond Toy at 2023-07-17T15:07:04+00:00 Merge branch 'issue-234-make-ascii-format-builtin' into 'master' Fix #234: Make :ascii external format builtin. Closes #234 See merge request cmucl/cmucl!155 - - - - - 0a35575a by Raymond Toy at 2023-07-17T15:07:47+00:00 Fix #242: Mask out unwanted bits for integer results - - - - - 5d4b0622 by Raymond Toy at 2023-07-17T15:07:49+00:00 Merge branch 'issue-242-c-call-char-result-wrong' into 'master' Fix #242: Mask out unwanted bits for integer results Closes #242 See merge request cmucl/cmucl!154 - - - - - bdd7294f by Raymond Toy at 2023-07-21T19:15:10+00:00 Fix #171: Readably print pathnames with :unspecific - - - - - 4bce99fc by Raymond Toy at 2023-07-21T19:15:11+00:00 Merge branch 'issue-171-readable-unspecific-pathnames' into 'master' Fix #171: Readably print pathnames with :unspecific Closes #171 See merge request cmucl/cmucl!134 - - - - - d37a3150 by Raymond Toy at 2023-07-22T00:19:38+00:00 Fix #248: Disassemble MOVS inst nicely - - - - - 95dfdcf3 by Raymond Toy at 2023-07-22T00:19:39+00:00 Merge branch 'issue-248-disassemble-movs-nicely' into 'master' Fix #248: Disassemble MOVS inst nicely Closes #248 See merge request cmucl/cmucl!156 - - - - - 8c6e050a by Raymond Toy at 2023-07-21T18:06:08-07:00 Remove extraneous debugging print Introduced in commit [0a35575aa0] for debugging and we forgot to remove it. - - - - - a85ad7cf by Raymond Toy at 2023-07-23T12:18:48-07:00 Update release notes with closed issues Should have been updated when the issue was closed, but we forgot. Update now. - - - - - d5c23293 by Raymond Toy at 2023-07-23T15:07:27-07:00 Update cmucl.pot Forgot to update cmucl.pot in previous commits/merges that changed docstrings for various things. Update it now. - - - - - f577eda6 by Raymond Toy at 2023-07-23T22:38:00+00:00 Fix #244: Add c-call:signed-char - - - - - 0411c386 by Raymond Toy at 2023-07-23T22:38:01+00:00 Merge branch 'issue-244-c-call-signed-char' into 'master' Fix #244: Add c-call:signed-char Closes #244 See merge request cmucl/cmucl!157 - - - - - 3e8b0a12 by Raymond Toy at 2023-07-26T13:43:15+00:00 Fix #245: Replace egrep with grep -E - - - - - 24152f4d by Raymond Toy at 2023-07-26T13:43:15+00:00 Merge branch 'issue-245-replace-egrep-with-grep' into 'master' Fix #245: Replace egrep with grep -E Closes #245 See merge request cmucl/cmucl!158 - - - - - 5b27393f by Carl Shapiro at 2023-07-30T21:15:48-07:00 Guard against a division by zero in test run reports - - - - - a7300f03 by Carl Shapiro at 2023-07-31T05:28:58+00:00 Merge branch 'zero-tests' into 'master' Guard against a division by zero when reporting test results See merge request cmucl/cmucl!161 - - - - - 33f11724 by Raymond Toy at 2023-08-12T07:34:55-07:00 Replace latin-1 character Latin_Small_Letter_I_With_Diaeresis In files/math.lisp, the word "naive" is spelled using the character \Latin_Small_Letter_I_With_Diaeresis. However, when compiling locally with a UTF-8 encoding (which is the default), this is invalid. The letter needs to be encoded as 2 octets. I'm too lazy to figure out how to get emacs to insert the correct encoded character so I'm replacing it with a simple "i". This makes the file pure ASCII, so it should work fine with a UTF-8 encoding. - - - - - a8ced15b by Carl Shapiro at 2023-08-14T04:45:23+00:00 Address #196: Fix issues with mapping and nconc accumulation - - - - - 310e41eb by Carl Shapiro at 2023-08-14T04:45:41+00:00 Merge branch 'mapcan' into 'master' Address #196: Fix issues with mapping and nconc accumulation See merge request cmucl/cmucl!162 - - - - - 19a305de by Raymond Toy at 2023-08-16T14:28:11+00:00 Address #240: Speed up set-difference - - - - - 9d593e3a by Raymond Toy at 2023-08-16T14:28:55+00:00 Merge branch 'issue-240-set-diff-with-hash-table' into 'master' Address #240: Speed up set-difference Closes #240 See merge request cmucl/cmucl!153 - - - - - 55c01f44 by Raymond Toy at 2023-08-17T13:33:59+00:00 Address #240: Speed up intersection by using a hashtable - - - - - 14d847f0 by Raymond Toy at 2023-08-17T13:34:15+00:00 Merge branch 'issue-240-intersection-with-hash-table' into 'master' Address #240: Speed up intersection by using a hashtable Closes #240 See merge request cmucl/cmucl!160 - - - - - c9ce7574 by Raymond Toy at 2023-08-17T13:36:18+00:00 Address #240: Speed up union by using a hashtable - - - - - 5c7536f0 by Raymond Toy at 2023-08-17T13:36:44+00:00 Merge branch 'issue-240-union-with-hash-table' into 'master' Address #240: Speed up union by using a hashtable Closes #240 See merge request cmucl/cmucl!159 - - - - - 181508a9 by Raymond Toy at 2023-08-17T06:47:03-07:00 Remove old version of union Oops. Forgot to remove this in !159, so we do it now. - - - - - a70248dd by Raymond Toy at 2023-08-19T13:38:11+00:00 Fix #249: Replace lea instruction for arithmetic - - - - - 5b3e11f9 by Raymond Toy at 2023-08-19T13:38:34+00:00 Merge branch 'issue-249-replace-lea-in-arith' into 'master' Fix #249: Replace lea instruction for arithmetic Closes #249 See merge request cmucl/cmucl!163 - - - - - f9ccc188 by Raymond Toy at 2023-08-21T18:03:25+00:00 Fix #252: Add script to run ansi-tests - - - - - eab9b876 by Raymond Toy at 2023-08-21T18:04:16+00:00 Merge branch 'issue-252-script-to-run-ansi-tests' into 'master' Fix #252: Add script to run ansi-tests Closes #252 See merge request cmucl/cmucl!165 - - - - - 0b497d8c by Raymond Toy at 2023-08-21T20:15:07+00:00 Address #240: Speed up subsetp with a hashtable - - - - - bfae1626 by Raymond Toy at 2023-08-21T20:15:21+00:00 Merge branch 'issue-240-subsetp-with-hash-table' into 'master' Address #240: Speed up subsetp with a hashtable Closes #240 See merge request cmucl/cmucl!164 - - - - - afaeb420 by Raymond Toy at 2023-08-22T14:00:25+00:00 Fix #253: Block-compile list-to-hashtable and callers - - - - - a5b2c0f8 by Raymond Toy at 2023-08-22T14:02:24+00:00 Merge branch 'issue-253-block-compile-list-to-hashtable' into 'master' Fix #253: Block-compile list-to-hashtable and callers Closes #253 See merge request cmucl/cmucl!166 - - - - - 427aaa31 by Raymond Toy at 2023-08-22T19:50:31-07:00 Fix warning that SIGNED-CHAR is also exported from C-CALL When we added `c-call:signed-char`, we forgot to also add it to the package exports list for the `c-call` package. Add it to get rid of the compiler warning. - - - - - 9581820a by Raymond Toy at 2023-08-25T13:32:42+00:00 Address #240: Clean up hashtable implementation of set functions - - - - - 39817da2 by Raymond Toy at 2023-08-25T13:32:51+00:00 Merge branch 'issue-240-clean-up-hashtable-impl' into 'master' Address #240: Clean up hashtable implementation of set functions See merge request cmucl/cmucl!168 - - - - - 87e54e03 by Raymond Toy at 2023-08-25T14:15:52+00:00 Address #240: Use hashtable for nset-diff, nunion, nintersection - - - - - 4542d55e by Raymond Toy at 2023-08-25T14:16:04+00:00 Merge branch 'issue-240-add-hashtable-for-destructive-set-ops' into 'master' Address #240: Use hashtable for nset-diff, nunion, nintersection See merge request cmucl/cmucl!167 - - - - - ffe3625a by Raymond Toy at 2023-08-29T13:01:16+00:00 Address #240: Rename processing macros for set operations - - - - - 747a82ba by Raymond Toy at 2023-08-29T13:04:36+00:00 Merge branch 'issue-240-clean-up-hashtable-for-sets-impl' into 'master' Address #240: Rename processing macros for set operations See merge request cmucl/cmucl!171 - - - - - d08a26c4 by Raymond Toy at 2023-08-29T14:53:04-07:00 Remove extra closing paren after %print-pathname Gets rid of a simple compiler warning. - - - - - 917c4240 by Raymond Toy at 2023-08-30T17:38:23+00:00 Fix #258: Remove get-page-size from linux-os.lisp - - - - - 77dee627 by Raymond Toy at 2023-08-30T17:38:40+00:00 Merge branch 'issue-258-remove-get-page-size-from-linux-os' into 'master' Fix #258: Remove get-page-size from linux-os.lisp Closes #258 See merge request cmucl/cmucl!172 - - - - - db531fef by Raymond Toy at 2023-08-30T17:59:50+00:00 Address #240: Add hashtable for set-exclusive-or - - - - - 766c6aa5 by Raymond Toy at 2023-08-30T18:00:08+00:00 Merge branch 'issue-240-add-hashtable-set-exclusive-or' into 'master' Address #240: Add hashtable for set-exclusive-or See merge request cmucl/cmucl!169 - - - - - 961c96ad by Raymond Toy at 2023-08-30T11:12:42-07:00 Update release notes with fixed issues - - - - - 3c318784 by Raymond Toy at 2023-09-09T02:27:58+00:00 Fix #261: Remove old get-system-info in bsd-os.lisp - - - - - a96a03e6 by Raymond Toy at 2023-09-09T02:28:11+00:00 Merge branch 'issue-261-remove-bsd-get-system-info' into 'master' Fix #261: Remove old get-system-info in bsd-os.lisp Closes #261 See merge request cmucl/cmucl!174 - - - - - c7d29a31 by Raymond Toy at 2023-10-14T06:57:56-07:00 Use snapshot 2023-08 for running CI. - - - - - 24fd8012 by Raymond Toy at 2023-11-14T23:44:10+00:00 Fix #265: Broken CI on Mac OS X - - - - - cdaa5def by Raymond Toy at 2023-11-14T23:44:44+00:00 Merge branch 'issue-265-ci-broken-on-mac-os' into 'master' Fix #265: Broken CI on Mac OS X Closes #265 See merge request cmucl/cmucl!176 - - - - - fb29f7d9 by Raymond Toy at 2023-11-24T17:43:34+00:00 Fix #259: Move *software-version* from LISP to SYSTEM package - - - - - 1af08245 by Raymond Toy at 2023-11-24T17:43:45+00:00 Merge branch 'issue-259-b-use-right-software-version' into 'master' Fix #259: Move *software-version* from LISP to SYSTEM package Closes #259 See merge request cmucl/cmucl!175 - - - - - 6b9f32f5 by Tarn Burton at 2023-11-29T22:39:39+00:00 Add support for Gray stream implementation of file-length - - - - - b218d29c by Raymond Toy at 2023-11-29T22:39:54+00:00 Merge branch 'gray-file-length' into 'master' Add support for Gray stream implementation of file-length See merge request cmucl/cmucl!179 - - - - - a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00 Fix #269: Add function to get user's home directory - - - - - 8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00 Merge branch 'issue-269-unix-get-user-homedir' into 'master' Fix #269: Add function to get user's home directory Closes #269 See merge request cmucl/cmucl!178 - - - - - bc8cb405 by Raymond Toy at 2023-12-07T23:09:31+00:00 Fix #266: Support ~user in namestrings - - - - - 81f0d53c by Raymond Toy at 2023-12-07T23:09:36+00:00 Merge branch 'issue-266-b-tilde-pathname-support' into 'master' Fix #266: Support ~user in namestrings Closes #266 See merge request cmucl/cmucl!180 - - - - - 0364a45b by Raymond Toy at 2023-12-07T15:25:03-08:00 Update pot file `stream-line-length` added a docstring that we forgot to add to our pot file. - - - - - b0fc47bd by Raymond Toy at 2023-12-08T05:53:23-08:00 Declare NAME to be a string in get-user-homedir-namestring For better error-checking, declare that the arg NAME for get-user-homedir-namestring must be a string, obviously. - - - - - 21560843 by Raymond Toy at 2023-12-08T15:36:45-08:00 Merge branch 'master' into issue-156-take-2-nan-comparison - - - - - 30 changed files: - .gitlab-ci.yml - benchmarks/cl-bench/files/math.lisp - bin/build.sh - bin/clean-target.sh - bin/make-extra-dist.sh - + bin/run-ansi-tests.sh - bin/run-tests.sh → bin/run-unit-tests.sh - + src/bootfiles/21e/boot-2023-08.lisp - src/code/alieneval.lisp - src/code/bsd-os.lisp - src/code/c-call.lisp - src/code/exports.lisp - src/code/extfmts.lisp - src/code/fd-stream-comp.lisp - src/code/filesys.lisp - src/code/linux-os.lisp - src/code/list.lisp - src/code/misc.lisp - src/code/os.lisp - src/code/pathname.lisp - src/code/stream.lisp - src/code/type.lisp - src/compiler/seqtran.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/c-call.lisp - src/compiler/x86/insts.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-os.pot - src/i18n/locale/cmucl.pot The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2bb842c1a485015f364a3f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2bb842c1a485015f364a3f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-187-imul-disassembly] 65 commits: Set LANG in build.sh
by Raymond Toy (＠rtoy) 08 Dec '23

08 Dec '23

Raymond Toy pushed to branch issue-187-imul-disassembly at cmucl / cmucl Commits: 4e433b83 by Raymond Toy at 2023-07-05T06:40:08-07:00 Set LANG in build.sh For some reason, on my Mac system, LANG isn't set and sometimes git messages are in Korean. So for consistency, set LANG in build.sh to a known value that should work everywhere. - - - - - da69492b by Raymond Toy at 2023-07-17T15:07:01+00:00 Fix #234: Make :ascii external format builtin. - - - - - 635d07ca by Raymond Toy at 2023-07-17T15:07:04+00:00 Merge branch 'issue-234-make-ascii-format-builtin' into 'master' Fix #234: Make :ascii external format builtin. Closes #234 See merge request cmucl/cmucl!155 - - - - - 0a35575a by Raymond Toy at 2023-07-17T15:07:47+00:00 Fix #242: Mask out unwanted bits for integer results - - - - - 5d4b0622 by Raymond Toy at 2023-07-17T15:07:49+00:00 Merge branch 'issue-242-c-call-char-result-wrong' into 'master' Fix #242: Mask out unwanted bits for integer results Closes #242 See merge request cmucl/cmucl!154 - - - - - bdd7294f by Raymond Toy at 2023-07-21T19:15:10+00:00 Fix #171: Readably print pathnames with :unspecific - - - - - 4bce99fc by Raymond Toy at 2023-07-21T19:15:11+00:00 Merge branch 'issue-171-readable-unspecific-pathnames' into 'master' Fix #171: Readably print pathnames with :unspecific Closes #171 See merge request cmucl/cmucl!134 - - - - - d37a3150 by Raymond Toy at 2023-07-22T00:19:38+00:00 Fix #248: Disassemble MOVS inst nicely - - - - - 95dfdcf3 by Raymond Toy at 2023-07-22T00:19:39+00:00 Merge branch 'issue-248-disassemble-movs-nicely' into 'master' Fix #248: Disassemble MOVS inst nicely Closes #248 See merge request cmucl/cmucl!156 - - - - - 8c6e050a by Raymond Toy at 2023-07-21T18:06:08-07:00 Remove extraneous debugging print Introduced in commit [0a35575aa0] for debugging and we forgot to remove it. - - - - - a85ad7cf by Raymond Toy at 2023-07-23T12:18:48-07:00 Update release notes with closed issues Should have been updated when the issue was closed, but we forgot. Update now. - - - - - d5c23293 by Raymond Toy at 2023-07-23T15:07:27-07:00 Update cmucl.pot Forgot to update cmucl.pot in previous commits/merges that changed docstrings for various things. Update it now. - - - - - f577eda6 by Raymond Toy at 2023-07-23T22:38:00+00:00 Fix #244: Add c-call:signed-char - - - - - 0411c386 by Raymond Toy at 2023-07-23T22:38:01+00:00 Merge branch 'issue-244-c-call-signed-char' into 'master' Fix #244: Add c-call:signed-char Closes #244 See merge request cmucl/cmucl!157 - - - - - 3e8b0a12 by Raymond Toy at 2023-07-26T13:43:15+00:00 Fix #245: Replace egrep with grep -E - - - - - 24152f4d by Raymond Toy at 2023-07-26T13:43:15+00:00 Merge branch 'issue-245-replace-egrep-with-grep' into 'master' Fix #245: Replace egrep with grep -E Closes #245 See merge request cmucl/cmucl!158 - - - - - 5b27393f by Carl Shapiro at 2023-07-30T21:15:48-07:00 Guard against a division by zero in test run reports - - - - - a7300f03 by Carl Shapiro at 2023-07-31T05:28:58+00:00 Merge branch 'zero-tests' into 'master' Guard against a division by zero when reporting test results See merge request cmucl/cmucl!161 - - - - - 33f11724 by Raymond Toy at 2023-08-12T07:34:55-07:00 Replace latin-1 character Latin_Small_Letter_I_With_Diaeresis In files/math.lisp, the word "naive" is spelled using the character \Latin_Small_Letter_I_With_Diaeresis. However, when compiling locally with a UTF-8 encoding (which is the default), this is invalid. The letter needs to be encoded as 2 octets. I'm too lazy to figure out how to get emacs to insert the correct encoded character so I'm replacing it with a simple "i". This makes the file pure ASCII, so it should work fine with a UTF-8 encoding. - - - - - a8ced15b by Carl Shapiro at 2023-08-14T04:45:23+00:00 Address #196: Fix issues with mapping and nconc accumulation - - - - - 310e41eb by Carl Shapiro at 2023-08-14T04:45:41+00:00 Merge branch 'mapcan' into 'master' Address #196: Fix issues with mapping and nconc accumulation See merge request cmucl/cmucl!162 - - - - - 19a305de by Raymond Toy at 2023-08-16T14:28:11+00:00 Address #240: Speed up set-difference - - - - - 9d593e3a by Raymond Toy at 2023-08-16T14:28:55+00:00 Merge branch 'issue-240-set-diff-with-hash-table' into 'master' Address #240: Speed up set-difference Closes #240 See merge request cmucl/cmucl!153 - - - - - 55c01f44 by Raymond Toy at 2023-08-17T13:33:59+00:00 Address #240: Speed up intersection by using a hashtable - - - - - 14d847f0 by Raymond Toy at 2023-08-17T13:34:15+00:00 Merge branch 'issue-240-intersection-with-hash-table' into 'master' Address #240: Speed up intersection by using a hashtable Closes #240 See merge request cmucl/cmucl!160 - - - - - c9ce7574 by Raymond Toy at 2023-08-17T13:36:18+00:00 Address #240: Speed up union by using a hashtable - - - - - 5c7536f0 by Raymond Toy at 2023-08-17T13:36:44+00:00 Merge branch 'issue-240-union-with-hash-table' into 'master' Address #240: Speed up union by using a hashtable Closes #240 See merge request cmucl/cmucl!159 - - - - - 181508a9 by Raymond Toy at 2023-08-17T06:47:03-07:00 Remove old version of union Oops. Forgot to remove this in !159, so we do it now. - - - - - a70248dd by Raymond Toy at 2023-08-19T13:38:11+00:00 Fix #249: Replace lea instruction for arithmetic - - - - - 5b3e11f9 by Raymond Toy at 2023-08-19T13:38:34+00:00 Merge branch 'issue-249-replace-lea-in-arith' into 'master' Fix #249: Replace lea instruction for arithmetic Closes #249 See merge request cmucl/cmucl!163 - - - - - f9ccc188 by Raymond Toy at 2023-08-21T18:03:25+00:00 Fix #252: Add script to run ansi-tests - - - - - eab9b876 by Raymond Toy at 2023-08-21T18:04:16+00:00 Merge branch 'issue-252-script-to-run-ansi-tests' into 'master' Fix #252: Add script to run ansi-tests Closes #252 See merge request cmucl/cmucl!165 - - - - - 0b497d8c by Raymond Toy at 2023-08-21T20:15:07+00:00 Address #240: Speed up subsetp with a hashtable - - - - - bfae1626 by Raymond Toy at 2023-08-21T20:15:21+00:00 Merge branch 'issue-240-subsetp-with-hash-table' into 'master' Address #240: Speed up subsetp with a hashtable Closes #240 See merge request cmucl/cmucl!164 - - - - - afaeb420 by Raymond Toy at 2023-08-22T14:00:25+00:00 Fix #253: Block-compile list-to-hashtable and callers - - - - - a5b2c0f8 by Raymond Toy at 2023-08-22T14:02:24+00:00 Merge branch 'issue-253-block-compile-list-to-hashtable' into 'master' Fix #253: Block-compile list-to-hashtable and callers Closes #253 See merge request cmucl/cmucl!166 - - - - - 427aaa31 by Raymond Toy at 2023-08-22T19:50:31-07:00 Fix warning that SIGNED-CHAR is also exported from C-CALL When we added `c-call:signed-char`, we forgot to also add it to the package exports list for the `c-call` package. Add it to get rid of the compiler warning. - - - - - 9581820a by Raymond Toy at 2023-08-25T13:32:42+00:00 Address #240: Clean up hashtable implementation of set functions - - - - - 39817da2 by Raymond Toy at 2023-08-25T13:32:51+00:00 Merge branch 'issue-240-clean-up-hashtable-impl' into 'master' Address #240: Clean up hashtable implementation of set functions See merge request cmucl/cmucl!168 - - - - - 87e54e03 by Raymond Toy at 2023-08-25T14:15:52+00:00 Address #240: Use hashtable for nset-diff, nunion, nintersection - - - - - 4542d55e by Raymond Toy at 2023-08-25T14:16:04+00:00 Merge branch 'issue-240-add-hashtable-for-destructive-set-ops' into 'master' Address #240: Use hashtable for nset-diff, nunion, nintersection See merge request cmucl/cmucl!167 - - - - - ffe3625a by Raymond Toy at 2023-08-29T13:01:16+00:00 Address #240: Rename processing macros for set operations - - - - - 747a82ba by Raymond Toy at 2023-08-29T13:04:36+00:00 Merge branch 'issue-240-clean-up-hashtable-for-sets-impl' into 'master' Address #240: Rename processing macros for set operations See merge request cmucl/cmucl!171 - - - - - d08a26c4 by Raymond Toy at 2023-08-29T14:53:04-07:00 Remove extra closing paren after %print-pathname Gets rid of a simple compiler warning. - - - - - 917c4240 by Raymond Toy at 2023-08-30T17:38:23+00:00 Fix #258: Remove get-page-size from linux-os.lisp - - - - - 77dee627 by Raymond Toy at 2023-08-30T17:38:40+00:00 Merge branch 'issue-258-remove-get-page-size-from-linux-os' into 'master' Fix #258: Remove get-page-size from linux-os.lisp Closes #258 See merge request cmucl/cmucl!172 - - - - - db531fef by Raymond Toy at 2023-08-30T17:59:50+00:00 Address #240: Add hashtable for set-exclusive-or - - - - - 766c6aa5 by Raymond Toy at 2023-08-30T18:00:08+00:00 Merge branch 'issue-240-add-hashtable-set-exclusive-or' into 'master' Address #240: Add hashtable for set-exclusive-or See merge request cmucl/cmucl!169 - - - - - 961c96ad by Raymond Toy at 2023-08-30T11:12:42-07:00 Update release notes with fixed issues - - - - - 3c318784 by Raymond Toy at 2023-09-09T02:27:58+00:00 Fix #261: Remove old get-system-info in bsd-os.lisp - - - - - a96a03e6 by Raymond Toy at 2023-09-09T02:28:11+00:00 Merge branch 'issue-261-remove-bsd-get-system-info' into 'master' Fix #261: Remove old get-system-info in bsd-os.lisp Closes #261 See merge request cmucl/cmucl!174 - - - - - c7d29a31 by Raymond Toy at 2023-10-14T06:57:56-07:00 Use snapshot 2023-08 for running CI. - - - - - 24fd8012 by Raymond Toy at 2023-11-14T23:44:10+00:00 Fix #265: Broken CI on Mac OS X - - - - - cdaa5def by Raymond Toy at 2023-11-14T23:44:44+00:00 Merge branch 'issue-265-ci-broken-on-mac-os' into 'master' Fix #265: Broken CI on Mac OS X Closes #265 See merge request cmucl/cmucl!176 - - - - - fb29f7d9 by Raymond Toy at 2023-11-24T17:43:34+00:00 Fix #259: Move *software-version* from LISP to SYSTEM package - - - - - 1af08245 by Raymond Toy at 2023-11-24T17:43:45+00:00 Merge branch 'issue-259-b-use-right-software-version' into 'master' Fix #259: Move *software-version* from LISP to SYSTEM package Closes #259 See merge request cmucl/cmucl!175 - - - - - 6b9f32f5 by Tarn Burton at 2023-11-29T22:39:39+00:00 Add support for Gray stream implementation of file-length - - - - - b218d29c by Raymond Toy at 2023-11-29T22:39:54+00:00 Merge branch 'gray-file-length' into 'master' Add support for Gray stream implementation of file-length See merge request cmucl/cmucl!179 - - - - - a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00 Fix #269: Add function to get user's home directory - - - - - 8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00 Merge branch 'issue-269-unix-get-user-homedir' into 'master' Fix #269: Add function to get user's home directory Closes #269 See merge request cmucl/cmucl!178 - - - - - bc8cb405 by Raymond Toy at 2023-12-07T23:09:31+00:00 Fix #266: Support ~user in namestrings - - - - - 81f0d53c by Raymond Toy at 2023-12-07T23:09:36+00:00 Merge branch 'issue-266-b-tilde-pathname-support' into 'master' Fix #266: Support ~user in namestrings Closes #266 See merge request cmucl/cmucl!180 - - - - - 0364a45b by Raymond Toy at 2023-12-07T15:25:03-08:00 Update pot file `stream-line-length` added a docstring that we forgot to add to our pot file. - - - - - b0fc47bd by Raymond Toy at 2023-12-08T05:53:23-08:00 Declare NAME to be a string in get-user-homedir-namestring For better error-checking, declare that the arg NAME for get-user-homedir-namestring must be a string, obviously. - - - - - 04d4d751 by Raymond Toy at 2023-12-08T13:39:35-08:00 Merge branch 'master' into issue-187-imul-disassembly - - - - - 30 changed files: - .gitlab-ci.yml - benchmarks/cl-bench/files/math.lisp - bin/build.sh - bin/clean-target.sh - bin/make-extra-dist.sh - + bin/run-ansi-tests.sh - bin/run-tests.sh → bin/run-unit-tests.sh - + src/bootfiles/21e/boot-2023-08.lisp - src/code/alieneval.lisp - src/code/bsd-os.lisp - src/code/c-call.lisp - src/code/exports.lisp - src/code/extfmts.lisp - src/code/fd-stream-comp.lisp - src/code/filesys.lisp - src/code/linux-os.lisp - src/code/list.lisp - src/code/misc.lisp - src/code/os.lisp - src/code/pathname.lisp - src/code/stream.lisp - src/code/type.lisp - src/compiler/seqtran.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/c-call.lisp - src/compiler/x86/insts.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-os.pot - src/i18n/locale/cmucl.pot The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d829b6e6fab5ff66ca9e0f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d829b6e6fab5ff66ca9e0f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Declare NAME to be a string in get-user-homedir-namestring
by Raymond Toy (＠rtoy) 08 Dec '23

08 Dec '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b0fc47bd by Raymond Toy at 2023-12-08T05:53:23-08:00 Declare NAME to be a string in get-user-homedir-namestring For better error-checking, declare that the arg NAME for get-user-homedir-namestring must be a string, obviously. - - - - - 1 changed file: - src/code/os.lisp Changes: ===================================== src/code/os.lisp ===================================== @@ -68,6 +68,7 @@ status code. If the home directory does not exist NIL is returned. The status is 0 if no errors occurred. Otherwise a non-zero value is returned. Examining errno may give information about what failed." + (declare (string name)) (cond ((zerop (length name)) (multiple-value-bind (user-info status) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b0fc47bd07ea5a0035f11cc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b0fc47bd07ea5a0035f11cc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update pot file
by Raymond Toy (＠rtoy) 07 Dec '23

07 Dec '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0364a45b by Raymond Toy at 2023-12-07T15:25:03-08:00 Update pot file `stream-line-length` added a docstring that we forgot to add to our pot file. - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -21329,6 +21329,10 @@ msgstr "" msgid "Implements FILE-POSITION for the stream for setting the position." msgstr "" +#: src/pcl/gray-streams.lisp +msgid "Implements FILE-LENGTH for the stream." +msgstr "" + #: src/pcl/gray-streams.lisp msgid "" "Used by READ-BYTE; returns either an integer, or the symbol :EOF\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0364a45b1159b92abf26148… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0364a45b1159b92abf26148… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #266: Support ~user in namestrings
by Raymond Toy (＠rtoy) 07 Dec '23

07 Dec '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: bc8cb405 by Raymond Toy at 2023-12-07T23:09:31+00:00 Fix #266: Support ~user in namestrings - - - - - 81f0d53c by Raymond Toy at 2023-12-07T23:09:36+00:00 Merge branch 'issue-266-b-tilde-pathname-support' into 'master' Fix #266: Support ~user in namestrings Closes #266 See merge request cmucl/cmucl!180 - - - - - 7 changed files: - src/code/exports.lisp - src/code/filesys.lisp - src/code/os.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-os.pot - tests/os.lisp - tests/pathname.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -2074,7 +2074,7 @@ "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" - "GET-USER-HOMEDIR-PATHNAME" + "GET-USER-HOMEDIR-NAMESTRING" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS" ===================================== src/code/filesys.lisp ===================================== @@ -301,105 +301,136 @@ (return (values (remove-backslashes namestr start index) (1+ index))))))))) +(defun expand-tilde-user-name (str start end) + ;; Quick exit if STR doesn't start with ~ or we have an empty string. + (when (or (= start end) + (char/= (schar str start) #\~)) + (return-from expand-tilde-user-name + (values str start end))) + + (let ((end-user (position #\/ str :start start :end end))) + ;; Quick exit if we can't find a "/" to terminate the user name. + (unless end-user + (return-from expand-tilde-user-name + (values str start end))) + (let* ((user-name (subseq str (1+ start) end-user)) + (homedir (get-user-homedir-namestring user-name))) + (unless homedir + (error "Unknown user ~S in namestring ~S" user-name (subseq str start end))) + ;; Replace the ~user part with the home directory, adjusting END + ;; because of the replacement. + (values (concatenate 'simple-base-string + (subseq str 0 start) + homedir + (subseq str end-user)) + start + (+ end (- (length homedir) + (length user-name) + 1)))))) + (defun parse-unix-namestring (namestr start end) (declare (type simple-base-string namestr) (type index start end)) - (multiple-value-bind - (absolute pieces) - (split-at-slashes namestr start end) - (let ((search-list - (if absolute - nil - (let ((first (car pieces))) - (multiple-value-bind - (search-list new-start) - (maybe-extract-search-list namestr - (car first) (cdr first)) - (when search-list - ;; Lose if this search-list is already defined as - ;; a logical host. Since the syntax for - ;; search-lists and logical pathnames are the - ;; same, we can't allow the creation of one when - ;; the other is defined. - (when (find-logical-host search-list nil) - (error (intl:gettext "~A already names a logical host") search-list)) - (setf absolute t) - (setf (car first) new-start)) - search-list))))) - (multiple-value-bind (name type version) - (let* ((tail (car (last pieces))) - (tail-start (car tail)) - (tail-end (cdr tail))) - (unless (= tail-start tail-end) - (setf pieces (butlast pieces)) - (cond ((string= namestr ".." :start1 tail-start :end1 tail-end) - ;; ".." is a directory. Add this piece to the - ;; list of pieces, and make the name/type/version - ;; nil. - (setf pieces (append pieces (list (cons tail-start tail-end)))) - (values nil nil nil)) - ((string= namestr "." :start1 tail-start :end1 tail-end) - ;; "." is a directory as well. - (setf pieces (append pieces (list (cons tail-start tail-end)))) - (values nil nil nil)) - ((not (find-if-not #'(lambda (c) - (char= c #\.)) - namestr :start tail-start :end tail-end)) - ;; Got a bunch of dots. Make it a file of the - ;; same name, and type the empty string. - (values (subseq namestr tail-start (1- tail-end)) "" nil)) - (t - (extract-name-type-and-version namestr tail-start tail-end))))) - ;; PVE: Make sure there are no illegal characters in the name - ;; such as #\Null and #\/. - (when (and (stringp name) - (find-if #'(lambda (x) - (or (char= x #\Null) (char= x #\/))) - name)) - (error 'parse-error)) - ;; Now we have everything we want. So return it. - (values nil ; no host for unix namestrings. - nil ; no devices for unix namestrings. - (collect ((dirs)) - (when search-list - (dirs (intern-search-list search-list))) - (dolist (piece pieces) - (let ((piece-start (car piece)) - (piece-end (cdr piece))) - (unless (= piece-start piece-end) - (cond ((string= namestr ".." :start1 piece-start - :end1 piece-end) - (dirs :up)) - ((string= namestr "**" :start1 piece-start - :end1 piece-end) - (dirs :wild-inferiors)) - (t - (dirs (maybe-make-pattern namestr - piece-start - piece-end))))))) - (cond (absolute - (cons :absolute (dirs))) - ((dirs) - ;; "." in a :relative directory is the same - ;; as if it weren't there, so remove them. - (cons :relative (delete "." (dirs) :test #'equal))) - (t - ;; If there is no directory and the name is - ;; "." and the type is NIL, we really got - ;; directory ".", so make it so. - (if (and (equal name ".") - (null type)) - (list :relative) - nil)))) - ;; A file with name "." and type NIL can't be the name - ;; of file on Unix because it's a directory. This was - ;; handled above, so we can just set the name to nil. - (if (and (equal name ".") - (null type)) - nil - name) - type - version))))) + ;; Look for "~user/" (or "~/"). If found replace it with the user's + ;; home directory + (multiple-value-bind (namestr start end) + (expand-tilde-user-name namestr start end) + (multiple-value-bind + (absolute pieces) + (split-at-slashes namestr start end) + (let ((search-list + (if absolute + nil + (let ((first (car pieces))) + (multiple-value-bind + (search-list new-start) + (maybe-extract-search-list namestr + (car first) (cdr first)) + (when search-list + ;; Lose if this search-list is already defined as + ;; a logical host. Since the syntax for + ;; search-lists and logical pathnames are the + ;; same, we can't allow the creation of one when + ;; the other is defined. + (when (find-logical-host search-list nil) + (error (intl:gettext "~A already names a logical host") search-list)) + (setf absolute t) + (setf (car first) new-start)) + search-list))))) + (multiple-value-bind (name type version) + (let* ((tail (car (last pieces))) + (tail-start (car tail)) + (tail-end (cdr tail))) + (unless (= tail-start tail-end) + (setf pieces (butlast pieces)) + (cond ((string= namestr ".." :start1 tail-start :end1 tail-end) + ;; ".." is a directory. Add this piece to the + ;; list of pieces, and make the name/type/version + ;; nil. + (setf pieces (append pieces (list (cons tail-start tail-end)))) + (values nil nil nil)) + ((string= namestr "." :start1 tail-start :end1 tail-end) + ;; "." is a directory as well. + (setf pieces (append pieces (list (cons tail-start tail-end)))) + (values nil nil nil)) + ((not (find-if-not #'(lambda (c) + (char= c #\.)) + namestr :start tail-start :end tail-end)) + ;; Got a bunch of dots. Make it a file of the + ;; same name, and type the empty string. + (values (subseq namestr tail-start (1- tail-end)) "" nil)) + (t + (extract-name-type-and-version namestr tail-start tail-end))))) + ;; PVE: Make sure there are no illegal characters in the name + ;; such as #\Null and #\/. + (when (and (stringp name) + (find-if #'(lambda (x) + (or (char= x #\Null) (char= x #\/))) + name)) + (error 'parse-error)) + ;; Now we have everything we want. So return it. + (values nil ; no host for unix namestrings. + nil ; no devices for unix namestrings. + (collect ((dirs)) + (when search-list + (dirs (intern-search-list search-list))) + (dolist (piece pieces) + (let ((piece-start (car piece)) + (piece-end (cdr piece))) + (unless (= piece-start piece-end) + (cond ((string= namestr ".." :start1 piece-start + :end1 piece-end) + (dirs :up)) + ((string= namestr "**" :start1 piece-start + :end1 piece-end) + (dirs :wild-inferiors)) + (t + (dirs (maybe-make-pattern namestr + piece-start + piece-end))))))) + (cond (absolute + (cons :absolute (dirs))) + ((dirs) + ;; "." in a :relative directory is the same + ;; as if it weren't there, so remove them. + (cons :relative (delete "." (dirs) :test #'equal))) + (t + ;; If there is no directory and the name is + ;; "." and the type is NIL, we really got + ;; directory ".", so make it so. + (if (and (equal name ".") + (null type)) + (list :relative) + nil)))) + ;; A file with name "." and type NIL can't be the name + ;; of file on Unix because it's a directory. This was + ;; handled above, so we can just set the name to nil. + (if (and (equal name ".") + (null type)) + nil + name) + type + version)))))) (defun unparse-unix-host (pathname) (declare (type pathname pathname) ===================================== src/code/os.lisp ===================================== @@ -58,32 +58,39 @@ (unix:get-unix-error-msg utime))) (values utime stime major-fault)))) -;;; GET-USER-HOMEDIR-PATHNAME -- Public +;;; GET-USER-HOMEDIR-NAMESTRING -- Public ;;; -(defun get-user-homedir-pathname (name) - _N"Get the user home directory for user named NAME. Two values are - returned: the pathname of the home directory and a status code. If - the home directory does not exist NIL is returned. The status is 0 - if no errors occurred. Otherwise a non-zero value is returned. - Examining errno may give information about what failed." - (alien:with-alien ((status c-call:int)) - (let (result) - (unwind-protect - (progn - (setf result - (alien:alien-funcall - (alien:extern-alien "os_get_user_homedir" - (function (alien:* c-call:c-string) - c-call:c-string - (* c-call:int))) - name - (alien:addr status))) - (if (and (zerop status) - (not (alien:null-alien result))) - (values (pathname - (concatenate 'string - (alien:cast result c-call:c-string) - "/")) - status) - (values nil status))) - (alien:free-alien result))))) +(defun get-user-homedir-namestring (name) + _N"Get the user home directory for user named NAME. If NAME is the empty + string, the home directory of the current user is returned. + + Two values are returned: the pathname of the home directory and a + status code. If the home directory does not exist NIL is returned. + The status is 0 if no errors occurred. Otherwise a non-zero value + is returned. Examining errno may give information about what failed." + (cond + ((zerop (length name)) + (multiple-value-bind (user-info status) + (unix:unix-getpwuid (unix:unix-getuid)) + (values (when user-info + (unix:user-info-dir user-info)) + status))) + (t + (alien:with-alien ((status c-call:int)) + (let (result) + (unwind-protect + (progn + (setf result + (alien:alien-funcall + (alien:extern-alien "os_get_user_homedir" + (function (alien:* c-call:c-string) + c-call:c-string + (* c-call:int))) + name + (alien:addr status))) + (if (and (zerop status) + (not (alien:null-alien result))) + (values (alien:cast result c-call:c-string) + status) + (values nil status))) + (alien:free-alien result))))))) ===================================== src/general-info/release-21f.md ===================================== @@ -39,6 +39,7 @@ public domain. * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory + * ~~#266~~ Support "~user" in namestrings * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -35,10 +35,12 @@ msgstr "" #: src/code/os.lisp msgid "" -"Get the user home directory for user named NAME. Two values are\n" -" returned: the pathname of the home directory and a status code. If\n" -" the home directory does not exist NIL is returned. The status is 0\n" -" if no errors occurred. Otherwise a non-zero value is returned.\n" -" Examining errno may give information about what failed." +"Get the user home directory for user named NAME. If NAME is the empty\n" +" string, the home directory of the current user is returned.\n" +"\n" +" Two values are returned: the pathname of the home directory and a\n" +" status code. If the home directory does not exist NIL is returned.\n" +" The status is 0 if no errors occurred. Otherwise a non-zero value\n" +" is returned. Examining errno may give information about what failed." msgstr "" ===================================== tests/os.lisp ===================================== @@ -7,7 +7,7 @@ (define-test user-homedir.1 "Test user-homedir" (:tag :issues) - ;; Simple test to see if get-user-homedir-pathname returns the + ;; Simple test to see if get-user-homedir-namestring returns the ;; expected value. Use getuid and getpwuid to figure out what the ;; name and home directory should be. (let* ((uid (unix:unix-getuid)) @@ -15,15 +15,13 @@ (assert-true uid) (assert-true user-info) (let* ((info-dir (unix:user-info-dir user-info)) - (info-name (unix:user-info-name user-info)) - (expected-home-pathname (pathname - (concatenate 'string info-dir "/")))) - (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname info-name) + (info-name (unix:user-info-name user-info))) + (multiple-value-bind (home-namestring status) + (system:get-user-homedir-namestring info-name) (assert-true info-dir) (assert-true info-name) - (assert-equal home-pathname expected-home-pathname) + (assert-equal home-namestring info-dir) (assert-eql status 0))))) (define-test user-homedir.2 @@ -33,6 +31,6 @@ ;; value for a user that does not exist. Well, we assume such a ;; user doesn't exist. (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname "zotuserunknown") + (system:get-user-homedir-namestring "zotuserunknown") (assert-eql home-pathname nil) (assert-eql status 0))) ===================================== tests/pathname.lisp ===================================== @@ -111,3 +111,34 @@ test (assert-equal printed-value (output pathname)) (assert-equal namestring (namestring pathname)))))) + +(define-test issue.266.pathname-tilde.unknown-user + (:tag :issues) + ;; This assumes that there's no user named "zotunknown". + (assert-error 'simple-error (parse-namestring "~zotunknown/*.*"))) + +(define-test issue.266.pathname-tilde.1 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". + (let ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + (dir-tilde (directory #p"~/*.*" :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home))) + +(define-test issue.266.pathname-tilde.2 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~user/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". We determine the user name via getuid + ;; #and getpwuid. + (let ((user-name (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid))))) + (assert-true user-name) + (let* ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + + (dir-tilde (directory (concatenate 'string + "~" + user-name + "/*.*") + :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8e067da95a2c8e3dad645b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8e067da95a2c8e3dad645b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-b-tilde-pathname-support] 3 commits: Update release notes
by Raymond Toy (＠rtoy) 07 Dec '23

07 Dec '23

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: e0ae2ea6 by Raymond Toy at 2023-12-07T14:49:30-08:00 Update release notes - - - - - 7ab1964d by Raymond Toy at 2023-12-07T14:49:48-08:00 Add tests for ~user in pathnames - - - - - 4f64fc56 by Raymond Toy at 2023-12-07T14:50:04-08:00 Update tests for changes in get-user-homedir-namestring The function name has changed and we return a namestring instead of a pathname. - - - - - 3 changed files: - src/general-info/release-21f.md - tests/os.lisp - tests/pathname.lisp Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -39,6 +39,7 @@ public domain. * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory + * ~~#266~~ Support "~user" in namestrings * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/os.lisp ===================================== @@ -7,7 +7,7 @@ (define-test user-homedir.1 "Test user-homedir" (:tag :issues) - ;; Simple test to see if get-user-homedir-pathname returns the + ;; Simple test to see if get-user-homedir-namestring returns the ;; expected value. Use getuid and getpwuid to figure out what the ;; name and home directory should be. (let* ((uid (unix:unix-getuid)) @@ -15,15 +15,13 @@ (assert-true uid) (assert-true user-info) (let* ((info-dir (unix:user-info-dir user-info)) - (info-name (unix:user-info-name user-info)) - (expected-home-pathname (pathname - (concatenate 'string info-dir "/")))) - (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname info-name) + (info-name (unix:user-info-name user-info))) + (multiple-value-bind (home-namestring status) + (system:get-user-homedir-namestring info-name) (assert-true info-dir) (assert-true info-name) - (assert-equal home-pathname expected-home-pathname) + (assert-equal home-namestring info-dir) (assert-eql status 0))))) (define-test user-homedir.2 @@ -33,6 +31,6 @@ ;; value for a user that does not exist. Well, we assume such a ;; user doesn't exist. (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname "zotuserunknown") + (system:get-user-homedir-namestring "zotuserunknown") (assert-eql home-pathname nil) (assert-eql status 0))) ===================================== tests/pathname.lisp ===================================== @@ -111,3 +111,34 @@ test (assert-equal printed-value (output pathname)) (assert-equal namestring (namestring pathname)))))) + +(define-test issue.266.pathname-tilde.unknown-user + (:tag :issues) + ;; This assumes that there's no user named "zotunknown". + (assert-error 'simple-error (parse-namestring "~zotunknown/*.*"))) + +(define-test issue.266.pathname-tilde.1 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". + (let ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + (dir-tilde (directory #p"~/*.*" :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home))) + +(define-test issue.266.pathname-tilde.2 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~user/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". We determine the user name via getuid + ;; #and getpwuid. + (let ((user-name (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid))))) + (assert-true user-name) + (let* ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + + (dir-tilde (directory (concatenate 'string + "~" + user-name + "/*.*") + :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1cd91a3d39ab5e69f405e2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1cd91a3d39ab5e69f405e2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0