January 2026 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-425-correctly-rounded-math-functions] 7 commits: Fix #457: delete-directory signals errors
by Raymond Toy (＠rtoy) 02 Jan '26

02 Jan '26

Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions at cmucl / cmucl Commits: e65f9f5c by Raymond Toy at 2025-12-17T07:04:10-08:00 Fix #457: delete-directory signals errors - - - - - 6034f935 by Raymond Toy at 2025-12-17T07:04:10-08:00 Merge branch 'issue-457-delete-directory-signals-errors' into 'master' Fix #457: delete-directory signals errors Closes #457 See merge request cmucl/cmucl!336 - - - - - 10efd37c by Raymond Toy at 2025-12-17T07:12:47-08:00 Remove extra blank lines Addresses comment from !337: https://gitlab.common-lisp.net/cmucl/cmucl/-/merge_requests/337#note_18529 Don't need to run CI for this. [skip-ci] - - - - - 885baf0f by Raymond Toy at 2025-12-24T12:43:58-08:00 Merge branch 'master' into issue-425-correctly-rounded-math-functions - - - - - 99d8540a by Raymond Toy at 2026-01-02T10:05:16-08:00 Fix #460: Exit with error if main unit-tests fail - - - - - 28de6c68 by Raymond Toy at 2026-01-02T10:05:17-08:00 Merge branch 'issue-460-ci-fails-if-unit-tests-do' into 'master' Fix #460: Exit with error if main unit-tests fail Closes #460 See merge request cmucl/cmucl!340 - - - - - c97ae992 by Raymond Toy at 2026-01-02T14:03:03-08:00 Merge branch 'master' into issue-425-correctly-rounded-math-functions - - - - - 8 changed files: - bin/run-unit-tests.sh - src/code/exports.lisp - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - tests/float-x86.lisp - tests/float.lisp - tests/os.lisp - tests/pathname.lisp Changes: ===================================== bin/run-unit-tests.sh ===================================== @@ -9,8 +9,8 @@ usage() { echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]" echo " -d test-dir Directory containing the unit test files" echo " -l lisp Lisp to use for the tests; defaults to lisp" - echo " -u Skip lisp-unit tests" echo " -p Skip package-local-nicknames test" + echo " -u Skip lisp-unit tests" echo " -? This help message" echo " -h This help message" echo "" @@ -27,13 +27,13 @@ usage() { } LISP=lisp -while getopts "uph?l:d:" arg +while getopts "puh?l:d:" arg do case $arg in l) LISP=$OPTARG ;; d) TESTDIR=$OPTARG ;; - u) SKIP_UNIT=yes ;; p) SKIP_PLN=yes ;; + u) SKIP_UNIT=yes ;; h|\?) usage ;; esac done @@ -47,12 +47,19 @@ mkdir test-tmp ln -s /bin/ls test-tmp/ls-link # Set the timestamps on 64-bit-timestamp-2038.txt and -# 64-bit-timestamp-2106.txt. The time for the first file is a -# negative value for a 32-bit time_t. The second file won't fit in a -# 32-bit time_t value. It's ok if this doesn't work in general, as -# long as it works on Linux for the stat test in tests/os.lisp. -touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt -touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt +# 64-bit-timestamp-2106.txt, but only for OSes where we know this +# works. (This is so we don't an annoying error message from touch +# that doesn't accept the -d option, like MacOS 10.13.) The time for +# the first file is a negative value for a 32-bit time_t. The second +# file won't fit in a 32-bit time_t value. It's ok if this doesn't +# work in general, as long as it works on Linux for the stat test in +# tests/os.lisp. +case `uname -s` in + Linux) + touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt + touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt + ;; +esac # Cleanup temp files and directories that we created during testing. function cleanup { @@ -95,8 +102,6 @@ if [ "$SKIP_UNIT" != "yes" ]; then fi ## Now run tests for trivial-package-local-nicknames -echo SKIP_PLN = $SKIP_PLN - if [ "$SKIP_PLN" != "yes" ]; then REPO=trivial-package-local-nicknames BRANCH=cmucl-updates ===================================== src/code/exports.lisp ===================================== @@ -1213,7 +1213,8 @@ "INVALID-FASL" "WITH-TEMPORARY-DIRECTORY" - "WITH-TEMPORARY-FILE") + "WITH-TEMPORARY-FILE" + "DELETE-DIRECTORY") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/extensions.lisp ===================================== @@ -673,9 +673,9 @@ (defun delete-directory (dirname &key recursive) _N"Delete the directory Dirname. If the Recursive is non-NIL, recursively delete the directory Dirname including all files and - subdirectories. Dirname must be a pathname to a directory. Any NAME - or TYPE components in Dirname are ignored." - (declare (type pathname dirname)) + subdirectories. Dirname must name a directory. Any NAME or TYPE + components in Dirname are ignored. A FILE-ERROR is signaled if any + directory cannot be deleted." (when recursive ;; Find all the files or directories in DIRNAME. (dolist (path (directory (merge-pathnames "*.*" dirname))) @@ -685,8 +685,15 @@ (delete-directory path :recursive t) (delete-file path)))) ;; Finally delete the directory. - (unix:unix-rmdir (namestring dirname)) - (values)) + (multiple-value-bind (ok errno) + (unix:unix-rmdir (namestring dirname)) + (unless ok + (error 'kernel:simple-file-error + :pathname dirname + :format-control (intl:gettext "Could not remove directory \"~A\": ~A.") + :format-arguments (list dirname + (unix:get-unix-error-msg errno)))) + ok)) ;;; WITH-TEMPORARY-DIRECTORY -- Public ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6011,8 +6011,13 @@ msgstr "" msgid "" "Delete the directory Dirname. If the Recursive is non-NIL,\n" " recursively delete the directory Dirname including all files and\n" -" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" -" or TYPE components in Dirname are ignored." +" subdirectories. Dirname must name a directory. Any NAME or TYPE\n" +" components in Dirname are ignored. A FILE-ERROR is signaled if any\n" +" directory cannot be deleted." +msgstr "" + +#: src/code/extensions.lisp +msgid "Could not remove directory \"~A\": ~A." msgstr "" #: src/code/extensions.lisp ===================================== tests/float-x86.lisp ===================================== @@ -5,6 +5,11 @@ (in-package "FLOAT-X86-TESTS") +;; This tests the floating-point modes for x86. This works only if we +;; have the feature :sse2 but not :darwin since darwin has always used +;; sse2 and not x87. But see also how FLOATING-POINT-MODES is +;; implemented in src/code/float-trap.lisp. +#+(and sse2 (not darwin)) (define-test set-floating-point-modes (let ((old-x87-modes (x86::x87-floating-point-modes)) (old-sse2-modes (x86::sse2-floating-point-modes)) ===================================== tests/float.lisp ===================================== @@ -343,8 +343,6 @@ (assert-true (typep new-mode 'x86::float-modes)) (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode)))) - - ;; Issue #458 (define-test dd-mult-overflow (:tag :issues) ===================================== tests/os.lisp ===================================== @@ -51,6 +51,7 @@ (assert-equal 2153718000 st-atime) (assert-equal 2153718000 st-mtime)))) +#+linux (define-test stat.64-bit-timestamp-2106 (:tag :issues) (let ((test-file #.(merge-pathnames "resources/64-bit-timestamp-2106.txt" ===================================== tests/pathname.lisp ===================================== @@ -144,14 +144,13 @@ (assert-equal dir-tilde dir-home)))) (define-test delete-directory - (let ((dir (ensure-directories-exist "tmp/a/b/c/"))) - ;; Verify that the directories were created. - (assert-equal "tmp/a/b/c/" - dir) - ;; Try to delete the directory. It should fail, which we verify - ;; by noting the directory listing is not empty. - (ext::delete-directory (pathname "tmp/")) - (assert-true (directory "tmp/")) - ;; Now recursively delete the directory. - (ext::delete-directory (pathname "tmp/") :recursive t) - (assert-false (directory "tmp/")))) + (:tag :issues) + (ext:with-temporary-directory (path) + (let ((dir (ensure-directories-exist (merge-pathnames "tmp/a/b/c/" path)))) + ;; Try to delete the directory. It should fail.. + (assert-error 'kernel:simple-file-error + (ext:delete-directory (merge-pathnames "tmp/" path))) + ;; Now recursively delete the directory. + (assert-true (ext:delete-directory (merge-pathnames "tmp/" path) + :recursive t)) + (assert-false (directory "tmp/"))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9c16379a168976b4d96b24… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9c16379a168976b4d96b24… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-454-signal-error-for-bad-pathname-parts] 18 commits: Dummy commit to run pipeline
by Raymond Toy (＠rtoy) 02 Jan '26

02 Jan '26

Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl Commits: b04aaec6 by Raymond Toy at 2025-12-03T18:30:46-08:00 Dummy commit to run pipeline Just removed an extra line at the end of the file. - - - - - 16c334b0 by Raymond Toy at 2025-12-04T15:46:41-08:00 Undo previous change that deleted a blank line Dummy commit to get CI to run to test out concurrent builds. (concurrent=2). - - - - - 25cd44a2 by Raymond Toy at 2025-12-04T17:57:49-08:00 Fix #455: Allow manual pipeline runs - - - - - ae1bdde7 by Raymond Toy at 2025-12-04T17:57:50-08:00 Merge branch 'issue-455-manual-pipeline-run' into 'master' Fix #455: Allow manual pipeline runs Closes #455 See merge request cmucl/cmucl!334 - - - - - fd2e83a1 by Raymond Toy at 2025-12-12T15:38:35-08:00 Fix two important typos in unix-get-username and delete-directory In `unix-get-username`, we were freeing `name` instead of `result`. In `delete-directory`, we misspelled `recursive` as `recusive`. Fix these typos. - - - - - b9494595 by Raymond Toy at 2025-12-12T15:54:05-08:00 Add some tests for unix-get-username and delete-directory Add a simple test that unix-get-username returns something useful. Add a test for delete-directory that tests it deletes directories as specified, include recursively. - - - - - e2b4641a by Raymond Toy at 2025-12-13T14:24:22-08:00 Fix #458: Fix spurious overflow in double-double multiply - - - - - 16097f45 by Raymond Toy at 2025-12-13T14:24:22-08:00 Merge branch 'issue-458-double-double-mult-overflow' into 'master' Fix #458: Fix spurious overflow in double-double multiply Closes #458 See merge request cmucl/cmucl!337 - - - - - f146f87f by Raymond Toy at 2025-12-13T15:11:21-08:00 Add fixed issue #458 to release notes Forgot to do that. [skip-ci] - - - - - 2c36bac8 by Raymond Toy at 2025-12-15T17:34:46-08:00 Use (new) Ubuntu VM to run CI instead of OpenSUSE - - - - - 7ebc2654 by Raymond Toy at 2025-12-15T17:34:46-08:00 Merge branch 'rtoy-add-ubuntu-runner' into 'master' Use (new) Ubuntu VM to run CI instead of OpenSUSE See merge request cmucl/cmucl!339 - - - - - e65f9f5c by Raymond Toy at 2025-12-17T07:04:10-08:00 Fix #457: delete-directory signals errors - - - - - 6034f935 by Raymond Toy at 2025-12-17T07:04:10-08:00 Merge branch 'issue-457-delete-directory-signals-errors' into 'master' Fix #457: delete-directory signals errors Closes #457 See merge request cmucl/cmucl!336 - - - - - 10efd37c by Raymond Toy at 2025-12-17T07:12:47-08:00 Remove extra blank lines Addresses comment from !337: https://gitlab.common-lisp.net/cmucl/cmucl/-/merge_requests/337#note_18529 Don't need to run CI for this. [skip-ci] - - - - - 99d8540a by Raymond Toy at 2026-01-02T10:05:16-08:00 Fix #460: Exit with error if main unit-tests fail - - - - - 28de6c68 by Raymond Toy at 2026-01-02T10:05:17-08:00 Merge branch 'issue-460-ci-fails-if-unit-tests-do' into 'master' Fix #460: Exit with error if main unit-tests fail Closes #460 See merge request cmucl/cmucl!340 - - - - - 66899cbc by Raymond Toy at 2026-01-02T12:59:03-08:00 Apply suggested change to use SOME and signal error not cerror - - - - - 266283df by Raymond Toy at 2026-01-02T13:15:03-08:00 Merge branch 'master' into issue-454-signal-error-for-bad-pathname-parts Fix merge conflict in tests/pathname.lisp - - - - - 14 changed files: - .gitlab-ci.yml - bin/run-unit-tests.sh - src/code/exports.lisp - src/code/extensions.lisp - src/code/pathname.lisp - src/code/unix.lisp - src/compiler/float-tran-dd.lisp - src/general-info/release-22a.md - src/i18n/locale/cmucl.pot - tests/float-x86.lisp - tests/float.lisp - tests/os.lisp - tests/pathname.lisp - tests/unix.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,6 +19,8 @@ variables: script: - echo PATH = $PATH - ls -F /usr/local/bin + # Make sure gitlab-runner is available because it's needed by the + # VM to upload artifacts. - type -all gitlab-runner # Download binaries. (Do we really need the extras tarball?) - $CURL -o cmucl-$version-$osname.tar.$tar_ext $download_url/cmucl-$version-$osname.tar.$tar_ext @@ -133,6 +135,7 @@ linux:install: - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" - if: $CI_PIPELINE_SOURCE == "branch" + - if: $CI_PIPELINE_SOURCE == "web" linux:build: <<: *build_configuration @@ -148,6 +151,7 @@ linux:build: - if: $CI_PIPELINE_SOURCE == "schedule" - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" + - if: $CI_PIPELINE_SOURCE == "web" linux:cross-build: stage: build @@ -316,38 +320,38 @@ linux:static-analyzer: - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1 #### OpenSUSE jobs #### -opensuse:install: +ubuntu:install: <<: *install_configuration tags: - - opensuse + - ubuntu variables: osname: "linux" CURL: "curl" -opensuse:build: +ubuntu:build: <<: *build_configuration tags: - - opensuse + - ubuntu needs: - - job: opensuse:install + - job: ubuntu:install artifacts: true -opensuse:test: +ubuntu:test: <<: *unit_test_configuration tags: - - opensuse + - ubuntu needs: # Needs artifacts from build (dist/) - - job: opensuse:build + - job: ubuntu:build artifacts: true -opensuse:ansi-test: +ubuntu:ansi-test: <<: *ansi_test_configuration tags: - - opensuse + - ubuntu needs: # Needs artifacts from build (dist/) - - job: opensuse:build + - job: ubuntu:build artifacts: true # Optional job that runs the markdown link checker. This is optional ===================================== bin/run-unit-tests.sh ===================================== @@ -9,6 +9,8 @@ usage() { echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]" echo " -d test-dir Directory containing the unit test files" echo " -l lisp Lisp to use for the tests; defaults to lisp" + echo " -p Skip package-local-nicknames test" + echo " -u Skip lisp-unit tests" echo " -? This help message" echo " -h This help message" echo "" @@ -25,11 +27,13 @@ usage() { } LISP=lisp -while getopts "h?l:d:" arg +while getopts "puh?l:d:" arg do case $arg in l) LISP=$OPTARG ;; d) TESTDIR=$OPTARG ;; + p) SKIP_PLN=yes ;; + u) SKIP_UNIT=yes ;; h|\?) usage ;; esac done @@ -43,12 +47,19 @@ mkdir test-tmp ln -s /bin/ls test-tmp/ls-link # Set the timestamps on 64-bit-timestamp-2038.txt and -# 64-bit-timestamp-2106.txt. The time for the first file is a -# negative value for a 32-bit time_t. The second file won't fit in a -# 32-bit time_t value. It's ok if this doesn't work in general, as -# long as it works on Linux for the stat test in tests/os.lisp. -touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt -touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt +# 64-bit-timestamp-2106.txt, but only for OSes where we know this +# works. (This is so we don't an annoying error message from touch +# that doesn't accept the -d option, like MacOS 10.13.) The time for +# the first file is a negative value for a 32-bit time_t. The second +# file won't fit in a 32-bit time_t value. It's ok if this doesn't +# work in general, as long as it works on Linux for the stat test in +# tests/os.lisp. +case `uname -s` in + Linux) + touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt + touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt + ;; +esac # Cleanup temp files and directories that we created during testing. function cleanup { @@ -69,39 +80,47 @@ fi # gcc since clang isn't always available. (cd "$TESTDIR" || exit 1 ; gcc -m32 -O3 -c test-return.c) -if [ $# -eq 0 ]; then - # Test directory arg for run-all-tests if a non-default - # No args so run all the tests - $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})" -else - # Run selected files. Convert each file name to uppercase and append "-TESTS" - result="" - for f in "$@" - do - new=$(echo "$f" | tr '[:lower:]' '[:upper:]') - result="$result "\"$new-TESTS\" - done - $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" +if [ "$SKIP_UNIT" != "yes" ]; then + if [ $# -eq 0 ]; then + # Test directory arg for run-all-tests if a non-default + # No args so run all the tests + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})" || + exit 1 + else + # Run selected files. Convert each file name to uppercase and append "-TESTS" + result="" + for f in "$@" + do + new=$(echo "$f" | tr '[:lower:]' '[:upper:]') + result="$result "\"$new-TESTS\" + done + # Run unit tests. Exits with a non-zero code if there's a failure. + + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" || + exit 1 + fi fi ## Now run tests for trivial-package-local-nicknames -REPO=trivial-package-local-nicknames -BRANCH=cmucl-updates +if [ "$SKIP_PLN" != "yes" ]; then + REPO=trivial-package-local-nicknames + BRANCH=cmucl-updates -set -x -if [ -d ../$REPO ]; then - (cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase) -else - (cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git) -fi + set -x + if [ -d ../$REPO ]; then + (cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase) + else + (cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git) + fi -LISP=$PWD/$LISP -cd ../$REPO || exit 1 -git checkout $BRANCH + LISP=$PWD/$LISP + cd ../$REPO || exit 1 + git checkout $BRANCH -# Run the tests. Exits with a non-zero code if there's a failure. -$LISP -noinit -nositeinit -batch <<'EOF' + # Run the tests. Exits with a non-zero code if there's a failure. + $LISP -noinit -nositeinit -batch <<'EOF' (require :asdf) (push (default-directory) asdf:*central-registry*) (asdf:test-system :trivial-package-local-nicknames) EOF +fi ===================================== src/code/exports.lisp ===================================== @@ -1213,7 +1213,8 @@ "INVALID-FASL" "WITH-TEMPORARY-DIRECTORY" - "WITH-TEMPORARY-FILE") + "WITH-TEMPORARY-FILE" + "DELETE-DIRECTORY") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/extensions.lisp ===================================== @@ -673,10 +673,10 @@ (defun delete-directory (dirname &key recursive) _N"Delete the directory Dirname. If the Recursive is non-NIL, recursively delete the directory Dirname including all files and - subdirectories. Dirname must be a pathname to a directory. Any NAME - or TYPE components in Dirname are ignored." - (declare (type pathname dirname)) - (when recusive + subdirectories. Dirname must name a directory. Any NAME or TYPE + components in Dirname are ignored. A FILE-ERROR is signaled if any + directory cannot be deleted." + (when recursive ;; Find all the files or directories in DIRNAME. (dolist (path (directory (merge-pathnames "*.*" dirname))) ;; If the path is a directory, recursively delete the directory. @@ -685,8 +685,15 @@ (delete-directory path :recursive t) (delete-file path)))) ;; Finally delete the directory. - (unix:unix-rmdir (namestring dirname)) - (values)) + (multiple-value-bind (ok errno) + (unix:unix-rmdir (namestring dirname)) + (unless ok + (error 'kernel:simple-file-error + :pathname dirname + :format-control (intl:gettext "Could not remove directory \"~A\": ~A.") + :format-arguments (list dirname + (unix:get-unix-error-msg errno)))) + ok)) ;;; WITH-TEMPORARY-DIRECTORY -- Public ===================================== src/code/pathname.lisp ===================================== @@ -843,13 +843,12 @@ a host-structure or string." (flet ((check-component-validity (name name-or-type) (when (stringp name) (when (eq host (%pathname-host *default-pathname-defaults*)) - (when (find-if #'(lambda (c) - ;; Illegal characters are a slash or NUL. - (or (char= c #\/) - (char= c #\nul))) + (when (some #'(lambda (c) + ;; Illegal characters are a slash or NUL. + (case c + ((#\/ #\null) t))) name) - (cerror _"Continue anyway" - _"Pathname component ~A cannot contain a slash or nul character: ~S" + (error _"Pathname component ~A cannot contain a slash or nul character: ~S" name-or-type name)))))) (check-component-validity name :pathname-name) (check-component-validity type :pathname-type) ===================================== src/code/unix.lisp ===================================== @@ -2564,5 +2564,5 @@ (cast result c-call:c-string) nil) status)) - (free-alien name))))) + (free-alien result))))) ===================================== src/compiler/float-tran-dd.lisp ===================================== @@ -290,10 +290,10 @@ (optimize (speed 3))) ;; If the numbers are too big, scale them done so SPLIT doesn't overflow. (multiple-value-bind (aa bb) - (values (if (> a +two970+) + (values (if (> (abs a) +two970+) (* a +two-53+) a) - (if (> b +two970+) + (if (> (abs b) +two970+) (* b +two-53+) b)) (let ((p (* aa bb))) @@ -314,10 +314,10 @@ (declare (optimize (inhibit-warnings 3))) ;; If the numbers was scaled down, we need to scale the ;; result back up. - (when (> a +two970+) + (when (> (abs a) +two970+) (setf p (* p +two53+) e (* e +two53+))) - (when (> b +two970+) + (when (> (abs b) +two970+) (setf p (* p +two53+) e (* e +two53+))) (values p e)))))))) ===================================== src/general-info/release-22a.md ===================================== @@ -34,6 +34,7 @@ public domain. * #446: Use C compiler to get errno values to update UNIX defpackage with errno symbols * #453: Use correct flags for analyzer and always save logs. + * #458: Spurious overflow in double-double-float multiply * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6011,8 +6011,13 @@ msgstr "" msgid "" "Delete the directory Dirname. If the Recursive is non-NIL,\n" " recursively delete the directory Dirname including all files and\n" -" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" -" or TYPE components in Dirname are ignored." +" subdirectories. Dirname must name a directory. Any NAME or TYPE\n" +" components in Dirname are ignored. A FILE-ERROR is signaled if any\n" +" directory cannot be deleted." +msgstr "" + +#: src/code/extensions.lisp +msgid "Could not remove directory \"~A\": ~A." msgstr "" #: src/code/extensions.lisp ===================================== tests/float-x86.lisp ===================================== @@ -5,6 +5,11 @@ (in-package "FLOAT-X86-TESTS") +;; This tests the floating-point modes for x86. This works only if we +;; have the feature :sse2 but not :darwin since darwin has always used +;; sse2 and not x87. But see also how FLOATING-POINT-MODES is +;; implemented in src/code/float-trap.lisp. +#+(and sse2 (not darwin)) (define-test set-floating-point-modes (let ((old-x87-modes (x86::x87-floating-point-modes)) (old-sse2-modes (x86::sse2-floating-point-modes)) ===================================== tests/float.lisp ===================================== @@ -342,3 +342,9 @@ (x86::x87-floating-point-modes))))) (assert-true (typep new-mode 'x86::float-modes)) (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode)))) + +;; Issue #458 +(define-test dd-mult-overflow + (:tag :issues) + (assert-equal -2w300 + (* -2w300 1w0))) ===================================== tests/os.lisp ===================================== @@ -51,6 +51,7 @@ (assert-equal 2153718000 st-atime) (assert-equal 2153718000 st-mtime)))) +#+linux (define-test stat.64-bit-timestamp-2106 (:tag :issues) (let ((test-file #.(merge-pathnames "resources/64-bit-timestamp-2106.txt" ===================================== tests/pathname.lisp ===================================== @@ -143,6 +143,18 @@ :truenamep nil :follow-links nil))) (assert-equal dir-tilde dir-home)))) +(define-test delete-directory + (:tag :issues) + (ext:with-temporary-directory (path) + (let ((dir (ensure-directories-exist (merge-pathnames "tmp/a/b/c/" path)))) + ;; Try to delete the directory. It should fail.. + (assert-error 'kernel:simple-file-error + (ext:delete-directory (merge-pathnames "tmp/" path))) + ;; Now recursively delete the directory. + (assert-true (ext:delete-directory (merge-pathnames "tmp/" path) + :recursive t)) + (assert-false (directory (merge-pathnames "tmp/" path)))))) + (define-test issue.454.illegal-pathname-chars (:tag :issues) ;; A slash (Unix directory separater) is not allowed. @@ -167,3 +179,4 @@ (make-pathname :name ".")) (assert-error 'simple-error (make-pathname :name ".."))) + ===================================== tests/unix.lisp ===================================== @@ -88,4 +88,7 @@ (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) - +(define-test unix-get-username + (let ((uid (unix:unix-getuid))) + (assert-true uid) + (assert-true (unix::unix-get-username uid)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2c51c988f73c44824b5d9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2c51c988f73c44824b5d9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #460: Exit with error if main unit-tests fail
by Raymond Toy (＠rtoy) 02 Jan '26

02 Jan '26

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 99d8540a by Raymond Toy at 2026-01-02T10:05:16-08:00 Fix #460: Exit with error if main unit-tests fail - - - - - 28de6c68 by Raymond Toy at 2026-01-02T10:05:17-08:00 Merge branch 'issue-460-ci-fails-if-unit-tests-do' into 'master' Fix #460: Exit with error if main unit-tests fail Closes #460 See merge request cmucl/cmucl!340 - - - - - 3 changed files: - bin/run-unit-tests.sh - tests/float-x86.lisp - tests/os.lisp Changes: ===================================== bin/run-unit-tests.sh ===================================== @@ -9,6 +9,8 @@ usage() { echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]" echo " -d test-dir Directory containing the unit test files" echo " -l lisp Lisp to use for the tests; defaults to lisp" + echo " -p Skip package-local-nicknames test" + echo " -u Skip lisp-unit tests" echo " -? This help message" echo " -h This help message" echo "" @@ -25,11 +27,13 @@ usage() { } LISP=lisp -while getopts "h?l:d:" arg +while getopts "puh?l:d:" arg do case $arg in l) LISP=$OPTARG ;; d) TESTDIR=$OPTARG ;; + p) SKIP_PLN=yes ;; + u) SKIP_UNIT=yes ;; h|\?) usage ;; esac done @@ -43,12 +47,19 @@ mkdir test-tmp ln -s /bin/ls test-tmp/ls-link # Set the timestamps on 64-bit-timestamp-2038.txt and -# 64-bit-timestamp-2106.txt. The time for the first file is a -# negative value for a 32-bit time_t. The second file won't fit in a -# 32-bit time_t value. It's ok if this doesn't work in general, as -# long as it works on Linux for the stat test in tests/os.lisp. -touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt -touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt +# 64-bit-timestamp-2106.txt, but only for OSes where we know this +# works. (This is so we don't an annoying error message from touch +# that doesn't accept the -d option, like MacOS 10.13.) The time for +# the first file is a negative value for a 32-bit time_t. The second +# file won't fit in a 32-bit time_t value. It's ok if this doesn't +# work in general, as long as it works on Linux for the stat test in +# tests/os.lisp. +case `uname -s` in + Linux) + touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt + touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt + ;; +esac # Cleanup temp files and directories that we created during testing. function cleanup { @@ -69,39 +80,47 @@ fi # gcc since clang isn't always available. (cd "$TESTDIR" || exit 1 ; gcc -m32 -O3 -c test-return.c) -if [ $# -eq 0 ]; then - # Test directory arg for run-all-tests if a non-default - # No args so run all the tests - $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})" -else - # Run selected files. Convert each file name to uppercase and append "-TESTS" - result="" - for f in "$@" - do - new=$(echo "$f" | tr '[:lower:]' '[:upper:]') - result="$result "\"$new-TESTS\" - done - $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" +if [ "$SKIP_UNIT" != "yes" ]; then + if [ $# -eq 0 ]; then + # Test directory arg for run-all-tests if a non-default + # No args so run all the tests + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})" || + exit 1 + else + # Run selected files. Convert each file name to uppercase and append "-TESTS" + result="" + for f in "$@" + do + new=$(echo "$f" | tr '[:lower:]' '[:upper:]') + result="$result "\"$new-TESTS\" + done + # Run unit tests. Exits with a non-zero code if there's a failure. + + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" || + exit 1 + fi fi ## Now run tests for trivial-package-local-nicknames -REPO=trivial-package-local-nicknames -BRANCH=cmucl-updates +if [ "$SKIP_PLN" != "yes" ]; then + REPO=trivial-package-local-nicknames + BRANCH=cmucl-updates -set -x -if [ -d ../$REPO ]; then - (cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase) -else - (cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git) -fi + set -x + if [ -d ../$REPO ]; then + (cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase) + else + (cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git) + fi -LISP=$PWD/$LISP -cd ../$REPO || exit 1 -git checkout $BRANCH + LISP=$PWD/$LISP + cd ../$REPO || exit 1 + git checkout $BRANCH -# Run the tests. Exits with a non-zero code if there's a failure. -$LISP -noinit -nositeinit -batch <<'EOF' + # Run the tests. Exits with a non-zero code if there's a failure. + $LISP -noinit -nositeinit -batch <<'EOF' (require :asdf) (push (default-directory) asdf:*central-registry*) (asdf:test-system :trivial-package-local-nicknames) EOF +fi ===================================== tests/float-x86.lisp ===================================== @@ -5,6 +5,11 @@ (in-package "FLOAT-X86-TESTS") +;; This tests the floating-point modes for x86. This works only if we +;; have the feature :sse2 but not :darwin since darwin has always used +;; sse2 and not x87. But see also how FLOATING-POINT-MODES is +;; implemented in src/code/float-trap.lisp. +#+(and sse2 (not darwin)) (define-test set-floating-point-modes (let ((old-x87-modes (x86::x87-floating-point-modes)) (old-sse2-modes (x86::sse2-floating-point-modes)) ===================================== tests/os.lisp ===================================== @@ -51,6 +51,7 @@ (assert-equal 2153718000 st-atime) (assert-equal 2153718000 st-mtime)))) +#+linux (define-test stat.64-bit-timestamp-2106 (:tag :issues) (let ((test-file #.(merge-pathnames "resources/64-bit-timestamp-2106.txt" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/10efd37c019d624ebee6a2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/10efd37c019d624ebee6a2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-456-more-accurate-complex-div] Address (most) review comments
by Raymond Toy (＠rtoy) 02 Jan '26

02 Jan '26

Raymond Toy pushed to branch issue-456-more-accurate-complex-div at cmucl / cmucl Commits: ef99f009 by Raymond Toy at 2026-01-02T09:40:54-08:00 Address (most) review comments - - - - - 3 changed files: - src/code/numbers.lisp - src/general-info/release-22a.md - tests/float.lisp Changes: ===================================== src/code/numbers.lisp ===================================== @@ -635,7 +635,7 @@ ;; Thus tt = (c + d*r). (cond ((>= (abs r) +rmin+) (let ((br (* b r))) - (if (/= br 0) + (if (/= br 0d0) (/ (+ a br) tt) ;; b*r underflows. Instead, compute ;; @@ -726,28 +726,26 @@ (multiple-value-bind (e f) (robust-subinternal b a d c) (complex e (- f)))))))))) - (let* ((a (realpart x)) - (b (imagpart x)) - (c (realpart y)) - (d (imagpart y)) - (ab (max (abs a) (abs b))) - (cd (max (abs c) (abs d))) + (let* ((max-ab (max (abs (realpart x)) + (abs (imagpart x)))) + (max-cd (max (abs (realpart y)) + (abs (imagpart y)))) (s 1d0)) (declare (double-float s)) ;; If a or b is big, scale down a and b. - (when (>= ab +rbig+) - (setf x (/ x 2) - s (* s 2))) + (when (>= max-ab +rbig+) + (setf x (/ x 2d0) + s (* s 2d0))) ;; If c or d is big, scale down c and d. - (when (>= cd +rbig+) - (setf y (/ y 2) - s (/ s 2))) + (when (>= max-cd +rbig+) + (setf y (/ y 2d0) + s (/ s 2d0))) ;; If a or b is tiny, scale up a and b. - (when (<= ab (* +rmin+ +2/eps+)) + (when (<= max-ab (* +rmin+ +2/eps+)) (setf x (* x +be+) s (/ s +be+))) ;; If c or d is tiny, scale up c and d. - (when (<= cd (* +rmin+ +2/eps+)) + (when (<= max-cd (* +rmin+ +2/eps+)) (setf y (* y +be+) s (* s +be+))) (* s @@ -909,6 +907,7 @@ (build-ratio (maybe-truncate nx gcd) (* (maybe-truncate y gcd) (denominator x))))))) + (defun %negate (n) (number-dispatch ((n number)) (((foreach fixnum single-float double-float #+long-float long-float)) ===================================== src/general-info/release-22a.md ===================================== @@ -35,6 +35,8 @@ public domain. defpackage with errno symbols * #453: Use correct flags for analyzer and always save logs. * #456: Improve accuracy for division of complex double-floats + using Baudin and Smith's robust complex division algorithm + with improvements by Patrick McGehearty. * #458: Spurious overflow in double-double-float multiply * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== tests/float.lisp ===================================== @@ -354,7 +354,7 @@ ;; Rudimentary code to read C %a formatted numbers that look like ;; "-0x1.c4dba4ba1ee79p-620". We assume STRING is exactly in this ;; format. No error-checking is done. -(defun parse-%a (string) +(defun parse-hex-float (string) (let* ((sign (if (char= (aref string 0) #\-) -1 1)) @@ -445,30 +445,43 @@ ;; 13 ;; Iteration 1. Without this, we would instead return ;; - ;; (complex (parse-%a "0x1.ba8df8075bceep+155") (parse-%a "-0x1.a4ad6329485f0p-895")) + ;; (complex (parse-hex-float "0x1.ba8df8075bceep+155") + ;; (parse-hex-float "-0x1.a4ad6329485f0p-895")) ;; ;; whose imaginary part is quite a bit off. - (list (complex (parse-%a "0x1.73a3dac1d2f1fp+509") (parse-%a "-0x1.c4dba4ba1ee79p-620")) - (complex (parse-%a "0x1.adf526c249cf0p+353") (parse-%a "0x1.98b3fbc1677bbp-697")) - (complex (parse-%a "0x1.BA8DF8075BCEEp+155") (parse-%a "-0x1.A4AD628DA5B74p-895")) + (list (complex (parse-hex-float "0x1.73a3dac1d2f1fp+509") + (parse-hex-float "-0x1.c4dba4ba1ee79p-620")) + (complex (parse-hex-float "0x1.adf526c249cf0p+353") + (parse-hex-float "0x1.98b3fbc1677bbp-697")) + (complex (parse-hex-float "0x1.BA8DF8075BCEEp+155") + (parse-hex-float "-0x1.A4AD628DA5B74p-895")) 53) ;; 14 ;; Iteration 2. - (list (complex (parse-%a "-0x0.000000008e4f8p-1022") (parse-%a "0x0.0000060366ba7p-1022")) - (complex (parse-%a "-0x1.605b467369526p-245") (parse-%a "0x1.417bd33105808p-256")) - (complex (parse-%a "0x1.cde593daa4ffep-810") (parse-%a "-0x1.179b9a63df6d3p-799")) + (list (complex (parse-hex-float "-0x0.000000008e4f8p-1022") + (parse-hex-float "0x0.0000060366ba7p-1022")) + (complex (parse-hex-float "-0x1.605b467369526p-245") + (parse-hex-float "0x1.417bd33105808p-256")) + (complex (parse-hex-float "0x1.cde593daa4ffep-810") + (parse-hex-float "-0x1.179b9a63df6d3p-799")) 52) ;; 15 ;; Iteration 3 - (list (complex (parse-%a "0x1.cb27eece7c585p-355 ") (parse-%a "0x0.000000223b8a8p-1022")) - (complex (parse-%a "-0x1.74e7ed2b9189fp-22") (parse-%a "0x1.3d80439e9a119p-731")) - (complex (parse-%a "-0x1.3b35ed806ae5ap-333") (parse-%a "-0x0.05e01bcbfd9f6p-1022")) + (list (complex (parse-hex-float "0x1.cb27eece7c585p-355 ") + (parse-hex-float "0x0.000000223b8a8p-1022")) + (complex (parse-hex-float "-0x1.74e7ed2b9189fp-22") + (parse-hex-float "0x1.3d80439e9a119p-731")) + (complex (parse-hex-float "-0x1.3b35ed806ae5ap-333") + (parse-hex-float "-0x0.05e01bcbfd9f6p-1022")) 53) ;; 16 ;; Iteration 4 - (list (complex (parse-%a "-0x1.f5c75c69829f0p-530") (parse-%a "-0x1.e73b1fde6b909p+316")) - (complex (parse-%a "-0x1.ff96c3957742bp+1023") (parse-%a "0x1.5bd78c9335899p+1021")) - (complex (parse-%a "-0x1.423c6ce00c73bp-710") (parse-%a "0x1.d9edcf45bcb0ep-708")) + (list (complex (parse-hex-float "-0x1.f5c75c69829f0p-530") + (parse-hex-float "-0x1.e73b1fde6b909p+316")) + (complex (parse-hex-float "-0x1.ff96c3957742bp+1023") + (parse-hex-float "0x1.5bd78c9335899p+1021")) + (complex (parse-hex-float "-0x1.423c6ce00c73bp-710") + (parse-hex-float "0x1.d9edcf45bcb0ep-708")) 52) )) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef99f00954a34ece65ebdb8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef99f00954a34ece65ebdb8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-460-ci-fails-if-unit-tests-do] Address review comments.
by Raymond Toy (＠rtoy) 02 Jan '26

02 Jan '26

Raymond Toy pushed to branch issue-460-ci-fails-if-unit-tests-do at cmucl / cmucl Commits: b0685947 by Raymond Toy at 2026-01-02T08:52:23-08:00 Address review comments. - - - - - 1 changed file: - bin/run-unit-tests.sh Changes: ===================================== bin/run-unit-tests.sh ===================================== @@ -9,8 +9,8 @@ usage() { echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]" echo " -d test-dir Directory containing the unit test files" echo " -l lisp Lisp to use for the tests; defaults to lisp" - echo " -u Skip lisp-unit tests" echo " -p Skip package-local-nicknames test" + echo " -u Skip lisp-unit tests" echo " -? This help message" echo " -h This help message" echo "" @@ -27,13 +27,13 @@ usage() { } LISP=lisp -while getopts "uph?l:d:" arg +while getopts "puh?l:d:" arg do case $arg in l) LISP=$OPTARG ;; d) TESTDIR=$OPTARG ;; - u) SKIP_UNIT=yes ;; p) SKIP_PLN=yes ;; + u) SKIP_UNIT=yes ;; h|\?) usage ;; esac done @@ -102,8 +102,6 @@ if [ "$SKIP_UNIT" != "yes" ]; then fi ## Now run tests for trivial-package-local-nicknames -echo SKIP_PLN = $SKIP_PLN - if [ "$SKIP_PLN" != "yes" ]; then REPO=trivial-package-local-nicknames BRANCH=cmucl-updates View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b0685947297a6d5102e5205… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b0685947297a6d5102e5205… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0