February 2025 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-381-cmucl-unix-os-specific] Show lisp version and git describe
by Raymond Toy (＠rtoy) 24 Feb '25

24 Feb '25

Raymond Toy pushed to branch issue-381-cmucl-unix-os-specific at cmucl / cmucl Commits: 8646fbc2 by Raymond Toy at 2025-02-23T20:16:15-08:00 Show lisp version and git describe To make it easier to tell if we have modified some files during the build (mostly pot files), print the version used by lisp (via cmucl-version.h) and from `git describe --dirty` after we've finished the complete build. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -197,6 +197,10 @@ osx:build: # If needed use -V to specify the version in case some tag makes git # describe return something that make-dist.sh doesn't like. - bin/make-dist.sh -I dist darwin-4 + # Show the version used for building lisp and then git so we + # easily tell if the osx build is dirty or not. + - cat src/lisp/cmucl-version.h + - git describe --dirty osx:test: stage: test View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8646fbc2f1eaf268a363eb3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8646fbc2f1eaf268a363eb3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #388: Analyzer stage needs cmucl-version.h
by Raymond Toy (＠rtoy) 24 Feb '25

24 Feb '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 490b48a3 by Raymond Toy at 2025-02-24T04:03:16+00:00 Fix #388: Analyzer stage needs cmucl-version.h - - - - - c0b4f40a by Raymond Toy at 2025-02-24T04:03:16+00:00 Merge branch 'issue-388-fix-linux-analyzer-stage' into 'master' Fix #388: Analyzer stage needs cmucl-version.h Closes #388 See merge request cmucl/cmucl!273 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -38,6 +38,7 @@ linux:build: - linux-2/*.log - linux-3/*.log - linux-4/ + - src/lisp/ needs: - job: linux:install artifacts: true View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cb65bb7e0227c6abcae63d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cb65bb7e0227c6abcae63d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-388-fix-linux-analyzer-stage
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed new branch issue-388-fix-linux-analyzer-stage at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-388-fix-linux-analy… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Comment out code uninterning errno symbols.
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 7bc67574 by Raymond Toy at 2025-02-23T06:36:13-08:00 Comment out code uninterning errno symbols. - - - - - 1 changed file: - src/bootfiles/21e/boot-2024-08.lisp Changes: ===================================== src/bootfiles/21e/boot-2024-08.lisp ===================================== @@ -12,6 +12,7 @@ ;; Unintern all the symbols in the UNIX package that conflict with the ;; symbols in the UNIX-ERRNO package. (in-package "UNIX") +#+nil (ext:without-package-locks (dolist (s '(UNIX:ENOENT UNIX:EINPROGRESS UNIX:EBADF UNIX:EXDEV UNIX:EADDRINUSE UNIX:EBADE UNIX:EIDRM UNIX:ENOTEMPTY UNIX:EISDIR UNIX:ESTRPIPE UNIX:EPERM View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7bc6757457770341a25857c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7bc6757457770341a25857c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Use plain awk and sort to create the file
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 064b90cd by Raymond Toy at 2025-02-22T21:15:34-08:00 Use plain awk and sort to create the file Modify gen-errno-exports just to print the errno symbols in any order without the defpackage form. Modify create-errno-pkg.sh to sort the output from awk and print the defpackage form. Hopefully this will work on osx without having to install gawk. - - - - - 2 changed files: - bin/create-errno-pkg.sh - bin/gen-errno-exports.gawk Changes: ===================================== bin/create-errno-pkg.sh ===================================== @@ -6,5 +6,11 @@ case `uname -s` in Linux) ERRNO_FILES=/usr/include/asm-generic/errno*.h ;; esac - -gawk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} + +cat <<EOF +(defpackage "UNIX-ERRNO" + (:export +`awk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} | sort ` + )) + +EOF ===================================== bin/gen-errno-exports.gawk ===================================== @@ -1,18 +1,3 @@ -BEGIN { - count = 0 -} - /^#define[ \t]+(E[A-Z0-9]+)[ \t]+([A-Z0-9]+).*$/ { - errlist[count] = $2; - ++count; -} - -END { - asort(errlist) - print "(defpackage \"UNIX-ERRNO\"" - print " (:export" - for (k = 1; k < count; ++k) { - printf " \"%s\"\n", errlist[k]; - } - print " ))\n" + printf " \"%s\"\n", $2 } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/064b90cd180467e1379827c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/064b90cd180467e1379827c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Forgot to commit create-errno-pkg.sh
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 5e031d45 by Raymond Toy at 2025-02-22T19:39:10-08:00 Forgot to commit create-errno-pkg.sh Script to create the errno package file. - - - - - 1 changed file: - + bin/create-errno-pkg.sh Changes: ===================================== bin/create-errno-pkg.sh ===================================== @@ -0,0 +1,10 @@ +#! /bin/sh + +# For each supported OS, ERRNO_FILES should be set to a list of all +# the files that contain the definitions of the errno values. +case `uname -s` in + Linux) ERRNO_FILES=/usr/include/asm-generic/errno*.h + ;; +esac + +gawk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e031d45478487f70234276… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e031d45478487f70234276… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Attempt to get CI to work
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 987d9d61 by Raymond Toy at 2025-02-22T19:22:36-08:00 Attempt to get CI to work In the CI scripts, remove the build dirs before building. Update bootstrap file to unintern the conflicting symbols. Currently only done for the Linux symbols. - - - - - 2 changed files: - .gitlab-ci.yml - src/bootfiles/21e/boot-2024-08.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,6 +49,7 @@ linux:build: # Regular build using the cross-compiled result or snapshot. The # analyzer job requires gcc, so make sure we build with gcc here # instead of clang. + - rm -rf linux-? - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # When the result of `git describe` cannot be used as a version @@ -193,6 +194,7 @@ osx:build: #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp # Regular build using the cross-compiled result or snapshot. # Need /opt/local/bin to get msgmerge and msgfmt programs. + - rm -rf darwin-? - PATH=/opt/local/bin:$PATH bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp # If needed use -V to specify the version in case some tag makes git # describe return something that make-dist.sh doesn't like. @@ -317,6 +319,7 @@ opensuse:build: # Regular build using the cross-compiled result or snapshot. The # analyzer job requires gcc, so make sure we build with gcc here # instead of clang. + - rm -rf linux-? - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # If needed use -V to specify the version in case some tag makes git ===================================== src/bootfiles/21e/boot-2024-08.lisp ===================================== @@ -8,3 +8,31 @@ (declare (ignore c)) (invoke-restart 'continue)))) (defconstant +ef-max+ 14)) + +;; Unintern all the symbols in the UNIX package that conflict with the +;; symbols in the UNIX-ERRNO package. +(in-package "UNIX") +(ext:without-package-locks + (dolist (s '(UNIX:ENOENT UNIX:EINPROGRESS UNIX:EBADF UNIX:EXDEV UNIX:EADDRINUSE + UNIX:EBADE UNIX:EIDRM UNIX:ENOTEMPTY UNIX:EISDIR UNIX:ESTRPIPE UNIX:EPERM + UNIX:ENOTCONN UNIX:EREMOTEIO UNIX:ESUCCESS UNIX:ETOOMANYREFS + UNIX:EPROTONOSUPPORT UNIX:EEXIST UNIX:ENOSR UNIX:EBADR UNIX:EHOSTUNREACH + UNIX:EADDRNOTAVAIL UNIX:ENOTDIR UNIX:ENETRESET UNIX:ENFILE UNIX:EALREADY + UNIX:EDEADLOCK UNIX:ELIBSCN UNIX:ESTALE UNIX:EISNAM UNIX:ETXTBSY UNIX:ENOSTR + UNIX:ETIME UNIX:ECHILD UNIX:EUCLEAN UNIX:EBADMSG UNIX:EINVAL UNIX:EFBIG + UNIX:EIO UNIX:EAFNOSUPPORT UNIX:ELIBBAD UNIX:EILSEQ UNIX:ECONNREFUSED + UNIX:EBUSY UNIX:ECONNRESET UNIX:ENOTUNIQ UNIX:E2BIG UNIX:EL2HLT + UNIX:EDESTADDRREQ UNIX:ENETUNREACH UNIX:EUSERS UNIX:ENOPKG UNIX:EFAULT + UNIX:ENODEV UNIX:ERANGE UNIX:EROFS UNIX:EPROTO UNIX:ENONET UNIX:ESRMNT + UNIX:ENOMSG UNIX:EPROTOTYPE UNIX:EREMOTE UNIX:ESPIPE UNIX:EL3RST + UNIX:ENOLINK UNIX:EREMCHG UNIX:ERESTART UNIX:ESRCH UNIX:ELIBMAX UNIX:ENOSYS + UNIX:ECOMM UNIX:ECONNABORTED UNIX:ENXIO UNIX:ELIBEXEC UNIX:EMLINK + UNIX:ENAMETOOLONG UNIX:ELNRNG UNIX:EMULTIHOP UNIX:ENOLCK UNIX:EDOM + UNIX:EAGAIN UNIX:EDOTDOT UNIX:EL2NSYNC UNIX:EADV UNIX:ENOEXEC UNIX:ELIBACC + UNIX:ENOTBLK UNIX:EDEADLK UNIX:ENOBUFS UNIX:ECHRNG UNIX:EDQUOT UNIX:EBADFD + UNIX:EPIPE UNIX:EMSGSIZE UNIX:ENETDOWN UNIX:EWOULDBLOCK UNIX:ESHUTDOWN + UNIX:EOPNOTSUPP UNIX:EL3HLT UNIX:EINTR UNIX:ENOTTY UNIX:ENOPROTOOPT + UNIX:EPFNOSUPPORT UNIX:ENOSPC UNIX:EBFONT UNIX:EISCONN UNIX:EMFILE + UNIX:ESOCKTNOSUPPORT UNIX:EHOSTDOWN UNIX:EACCES UNIX:ENOTSOCK UNIX:EBADRQC + UNIX:ELOOP UNIX:ETIMEDOUT UNIX:ENAVAIL UNIX:EBADSLT UNIX:ENOANO UNIX:ENOMEM)) + (unintern s "UNIX"))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/987d9d6153ac3a9219809a5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/987d9d6153ac3a9219809a5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-365-add-strerror-with-generated-errno-pkg
by Raymond Toy (＠rtoy) 22 Feb '25

22 Feb '25

Raymond Toy pushed new branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-365-add-strerror-wi… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-381-cmucl-unix-os-specific] 15 commits: Fix #382: Make command-line options be case-sensitive instead of case-insenstive
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch issue-381-cmucl-unix-os-specific at cmucl / cmucl Commits: 03081eeb by Raymond Toy at 2025-02-17T01:52:03+00:00 Fix #382: Make command-line options be case-sensitive instead of case-insenstive - - - - - ee669070 by Raymond Toy at 2025-02-17T01:52:04+00:00 Merge branch 'issue-382-command-line-options-case-sensitive' into 'master' Fix #382: Make command-line options be case-sensitive instead of case-insenstive Closes #382 See merge request cmucl/cmucl!267 - - - - - 459c91bc by Raymond Toy at 2025-02-18T02:53:23+00:00 Fix #375: Return the name of the temp file or directory - - - - - daf83c84 by Raymond Toy at 2025-02-18T02:53:23+00:00 Merge branch 'issue-375-mkstemp-return-filename' into 'master' Fix #375: Return the name of the temp file or directory Closes #375 See merge request cmucl/cmucl!265 - - - - - ef48eb2a by Carl Shapiro at 2025-02-18T22:46:55-08:00 Document sap-ref-64 and signed-sap-ref-64 These functions have existed on almost all targets for many years now. - - - - - 6c8861a0 by Raymond Toy at 2025-02-20T13:55:13+00:00 Fix #384: Use correct header guard in elf.h - - - - - 5b452f9a by Raymond Toy at 2025-02-20T13:55:13+00:00 Merge branch 'issue-384-use-correct-header-guard' into 'master' Fix #384: Use correct header guard in elf.h Closes #384 See merge request cmucl/cmucl!270 - - - - - a6846d44 by Raymond Toy at 2025-02-21T03:13:50+00:00 Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c - - - - - f21c6507 by Raymond Toy at 2025-02-21T03:13:51+00:00 Merge branch 'issue-385-fix-compiler-warning-linux-os' into 'master' Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c Closes #385 See merge request cmucl/cmucl!271 - - - - - f370206e by Raymond Toy at 2025-02-21T13:25:03+00:00 Fix #365: Add Unix interface to strerror and use in get-unix-error-msg - - - - - 8ea8e2a0 by Raymond Toy at 2025-02-21T13:25:03+00:00 Merge branch 'issue-365-get-unix-error-msg-uses-strerror' into 'master' Fix #365: Add Unix interface to strerror and use in get-unix-error-msg Closes #365 See merge request cmucl/cmucl!272 - - - - - 576f422e by Raymond Toy at 2025-02-21T05:42:51-08:00 Update pot file due to changes introduced in !272 Some docstrings changed, so the pot file needs updating. Don't need to run CI for this change. [SKIP-CI] - - - - - cb65bb7e by Raymond Toy at 2025-02-21T05:52:50-08:00 Add recently closed issues to release notes Don't need CI for this change [SKIP-CI] - - - - - 705a8753 by Raymond Toy at 2025-02-21T07:06:41-08:00 Merge branch 'master' into issue-381-cmucl-unix-os-specific - - - - - 5fb73c95 by Raymond Toy at 2025-02-21T07:20:13-08:00 Just prefix docstring with _N Instead of trying to create a new text domain, prefix the docstring for `*enable-darwin-path-normalization*` with `_N` so that it's included even when not compiling on macos. Update cmucl.pot with the new docstring. - - - - - 10 changed files: - src/code/commandline.lisp - src/code/pathname.lisp - src/code/unix.lisp - src/docs/cmu-user/unix.tex - src/general-info/release-21f.md - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/Linux-os.c - src/lisp/elf.h - + tests/unix.lisp Changes: ===================================== src/code/commandline.lisp ===================================== @@ -190,17 +190,17 @@ (demons *command-switch-demons*)) (flet ((invoke-demon (switch) (let* ((name (cmd-switch-name switch)) - (demon (cdr (assoc name demons :test #'string-equal)))) + (demon (cdr (assoc name demons :test #'string=)))) (cond (demon (funcall demon switch)) - ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car) + ((or (member name *legal-cmd-line-switches* :test #'string= :key #'car) (not *complain-about-illegal-switches*))) (t (warn (intl:gettext "~S is an illegal switch") switch))) (lisp::finish-standard-output-streams)))) ;; We want to process -help (or --help) first, if it's given. ;; Since we're asking for help, we don't want to process any of ;; the other switches. - (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal) - (find "-help" switches :key #'cmd-switch-name :test #'string-equal)))) + (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string=) + (find "-help" switches :key #'cmd-switch-name :test #'string=)))) (if maybe-help (invoke-demon maybe-help) (dolist (switch switches t) ===================================== src/code/pathname.lisp ===================================== @@ -268,13 +268,12 @@ ;;; from parsed arguments. #+darwin -(intl:with-textdomain ("cmucl-darwin-os") (defvar *enable-darwin-path-normalization* nil - "When non-NIL, pathnames are on Darwin are normalized when created. + _N"When non-NIL, pathnames are on Darwin are normalized when created. Otherwise, the pathnames are unchanged. This must be NIL during bootstrapping because Unicode is not yet - available.")) + available.") (defun %make-pathname-object (host device directory name type version) (if (typep host 'logical-host) ===================================== src/code/unix.lisp ===================================== @@ -2053,9 +2053,7 @@ _N"Returns a string describing the error number which was returned by a UNIX system call." (declare (type integer error-number)) - (if (array-in-bounds-p *unix-errors* error-number) - (svref *unix-errors* error-number) - (format nil _"Unknown error [~d]" error-number))) + (unix::unix-strerror error-number)) ;;;; Lisp types used by syscalls. @@ -2913,28 +2911,82 @@ (defun unix-mkstemp (template) _N"Generates a unique temporary file name from TEMPLATE, and creates and opens the file. On success, the corresponding file descriptor - and name of the file is returned. - - The last six characters of the template must be \"XXXXXX\"." - ;; Hope this buffer is large enough! - (let ((octets (%name->file template))) - (syscall ("mkstemp" c-call:c-string) + and name of the file is returned. Otherwise, NIL and the UNIX error + code is returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Convert the string to octets using the + ;; *FILENAME-ENCODING*. Should we signal an error if the + ;; string can't be encoded? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (syscall ("mkstemp" (* c-call:char)) (values result - ;; Convert the file name back to a Lisp string. - (%file->name octets)) - octets))) + (progn + ;; Copy out the alien bytes and convert back + ;; to a lisp string. + (system:without-gcing + (kernel:system-area-copy (alien-sap buffer) 0 + (vector-sap octets) 0 + (* length vm:byte-bits))) + (stream:octets-to-string octets + :external-format format))) + (cast buffer (* c-call:char)))))) (defun unix-mkdtemp (template) - _N"Generate a uniquely named temporary directory from Template, - which must have \"XXXXXX\" as the last six characters. The + _N"Generate a uniquely named temporary directory from Template. The directory is created with permissions 0700. The name of the - directory is returned." - (let* ((octets (%name->file template)) - (result (alien-funcall - (extern-alien "mkdtemp" - (function (* char) - c-call:c-string)) - octets))) - (if (null-alien result) - (values nil (unix-errno)) - (%file->name octets)))) + directory is returned. + + If the directory cannot be created NIL and the UNIX error code is + returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Encode the string using the appropriate + ;; *filename-encoding*. Should we signal an error if the + ;; string can't be encoded in that format? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (let ((result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + (* char))) + (cast buffer (* char))))) + ;; If mkdtemp worked, a non-NIL value is returned, return the + ;; resulting name. Otherwise, return NIL and the errno. + (if (null-alien result) + (values nil (unix-errno)) + (%file->name (cast result c-call:c-string))))))) + +(defun unix-strerror (errno) + _N"Returns a string that describes the error code Errno" + (let ((result + (alien-funcall + (extern-alien "strerror" + (function (* char) int)) + errno))) + ;; Result from strerror can be localized so we need to decode + ;; those octets to get a proper Lisp string. + (string-decode (cast result c-string) :default))) ===================================== src/docs/cmu-user/unix.tex ===================================== @@ -244,9 +244,10 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{sap-ref-16}{\args{\var{sap} \var{offset}}} - \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}}} - - These functions return the 8, 16 or 32 bit unsigned integer at + \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}} + \defunx[system:]{sap-ref-64}{\args{\var{sap} \var{offset}}} + + These functions return the 8, 16, 32 or 64 bit unsigned integer at \var{offset} from \var{sap}. The \var{offset} is always a byte offset, regardless of the number of bits accessed. \code{setf} may be used with the these functions to deposit values into virtual @@ -256,7 +257,8 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{signed-sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-16}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-32}{\args{\var{sap} \var{offset}}} - + \defunx[system:]{signed-sap-ref-64}{\args{\var{sap} \var{offset}}} + These functions are the same as the above unsigned operations, except that they sign-extend, returning a negative number if the high bit is set. ===================================== src/general-info/release-21f.md ===================================== @@ -117,9 +117,12 @@ public domain. * ~~#363~~ Version numbers added to files and directories. The distribution layout has changed. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` - * ~~#367~~ Add stream:string-count-octets to count octets in a string + * ~~#367~~ Add `stream:string-count-octets` to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#375~~ `unix-mkstemp` and `unix-mkdtemp` actually returns the + file names now. * ~~#379~~ Support GNU-style command-line option names + * ~~#382~~ Command-line options are case-sensitive * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1284,10 +1284,6 @@ msgid "" " UNIX system call." msgstr "" -#: src/code/unix.lisp -msgid "Unknown error [~d]" -msgstr "" - #: src/code/unix.lisp msgid "" "Perform the UNIX select(2) system call.\n" @@ -1434,16 +1430,21 @@ msgstr "" msgid "" "Generates a unique temporary file name from TEMPLATE, and creates\n" " and opens the file. On success, the corresponding file descriptor\n" -" and name of the file is returned.\n" -"\n" -" The last six characters of the template must be \"XXXXXX\"." +" and name of the file is returned. Otherwise, NIL and the UNIX error\n" +" code is returned." msgstr "" #: src/code/unix.lisp msgid "" -"Generate a uniquely named temporary directory from Template,\n" -" which must have \"XXXXXX\" as the last six characters. The\n" +"Generate a uniquely named temporary directory from Template. The\n" " directory is created with permissions 0700. The name of the\n" -" directory is returned." +" directory is returned.\n" +"\n" +" If the directory cannot be created NIL and the UNIX error code is\n" +" returned." +msgstr "" + +#: src/code/unix.lisp +msgid "Returns a string that describes the error code Errno" msgstr "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -9667,6 +9667,15 @@ msgid "" " an otherwise undefined logical host." msgstr "" +#: src/code/pathname.lisp +msgid "" +"When non-NIL, pathnames are on Darwin are normalized when created.\n" +" Otherwise, the pathnames are unchanged.\n" +"\n" +" This must be NIL during bootstrapping because Unicode is not yet\n" +" available." +msgstr "" + #: src/code/pathname.lisp msgid "A path specification, either a string, file-stream or pathname." msgstr "" ===================================== src/lisp/Linux-os.c ===================================== @@ -476,7 +476,7 @@ sigsegv_handler(HANDLER_ARGS) #endif if (gc_write_barrier(code->si_addr)) return; - DPRINTF(0, (stderr, "sigsegv: PC: %p\n", SC_PC(os_context))); + DPRINTF(0, (stderr, "sigsegv: PC: %#lx\n", SC_PC(os_context))); #ifdef RED_ZONE_HIT { ===================================== src/lisp/elf.h ===================================== @@ -9,7 +9,7 @@ * interface to both elf and mach-o support. I (rtoy) was too lazy to * change the name to something more descriptive. */ -#if !defined(_ELF_H_INCLUDED_) +#if !defined(ELF_H_INCLUDED) #define ELF_H_INCLUDED ===================================== tests/unix.lisp ===================================== @@ -0,0 +1,91 @@ +;;; Tests for the unix interface + +(defpackage :unix-tests + (:use :cl :lisp-unit)) + +(in-package "UNIX-TESTS") + +(define-test mkstemp.name-returned + (:tag :issues) + (let (fd filename) + (unwind-protect + (progn + (let ((template "test-XXXXXX")) + (multiple-value-setq (fd filename) + (unix::unix-mkstemp (copy-seq template))) + (assert-true fd) + (assert-true (equalp (length filename) (length template))) + (assert-false (equalp filename template)) + (assert-true (>= 5 (mismatch filename template)))))) + (when fd + (unix:unix-unlink filename))))) + +(define-test mkstemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + fd name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "test-XXXXXX")) + (x-posn (position #\X template))) + (multiple-value-setq (fd name) + (unix::unix-mkstemp template)) + (assert-true fd) + (assert-false (search "XXXXXX" name) + name) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name))) + (when fd + (unix:unix-unlink name))))) + +(define-test mkstemp.bad-path + (:tag :issues) + (multiple-value-bind (fd errno) + ;; Assumes that the directory "random-dir" doesn't exist + (unix::unix-mkstemp "random-dir/test-XXXXXX") + ;; Can't create and open the file so the FD should be NIL, and a + ;; positive Unix errno value should be returned. + (assert-false fd) + (assert-true (and (integerp errno) (plusp errno))))) + +(define-test mkdtemp.name-returned + (:tag :issues) + (let (name) + (unwind-protect + (progn + (setf name (unix::unix-mkdtemp "dir-XXXXXX")) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "dir-XXXXXX")) + (x-posn (position #\X template))) + (setf name (unix::unix-mkdtemp template)) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name)) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name x-posn))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.bad-path + (:tag :issues) + (multiple-value-bind (result errno) + (unix::unix-mkdtemp "random-dir/dir-XXXXXX") + (assert-false result) + (assert-true (and (integerp errno) (plusp errno))))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/767a5f09aab6bbd29437ff… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/767a5f09aab6bbd29437ff… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Convert more tests to use with-temporary-foo
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 63fdbf0b by Raymond Toy at 2025-02-21T06:14:57-08:00 Convert more tests to use with-temporary-foo - - - - - c8b9082b by Raymond Toy at 2025-02-21T06:21:49-08:00 Convert test to use with-temporary-file - - - - - 2 changed files: - tests/fd-streams.lisp - tests/trac.lisp Changes: ===================================== tests/fd-streams.lisp ===================================== @@ -17,6 +17,7 @@ (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) +#+nil (define-test clear-output-1 (:tag :trac) (assert-eql @@ -34,3 +35,20 @@ (setf s (open *test-file*)) (file-length s)) (delete-file *test-file*)))) + +(define-test clear-output-1 + (:tag :trac) + (assert-eql + 0 + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + ;; Write a character to the (fully buffered) output + ;; stream. Clear the output and close the file. Nothing + ;; should have been written to the file. + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open test-file)) + (file-length s))))) ===================================== tests/trac.lisp ===================================== @@ -123,6 +123,7 @@ (assert-equal (values #\H 8) (bug :utf32))))) +#+nil (define-test trac.36 (:tag :trac) (flet ((bug (&optional (format :utf16)) @@ -137,6 +138,24 @@ (assert-equal (values #\H 8) (bug :utf32)))) +(define-test trac.36 + (:tag :trac) + (flet ((bug (&optional (format :utf16)) + (ext:with-temporary-file (path) + (with-open-file (s path + :direction :output + :external-format format) + (format s "Hello~%")) + (with-open-file (s path + :direction :input + :external-format format) + (let ((ch (read-char s))) + (values ch (file-position s))))))) + (assert-equal (values #\H 4) + (bug :utf16)) + (assert-equal (values #\H 8) + (bug :utf32))))) + #+nil (define-test trac.43 (:tag :trac) @@ -157,6 +176,7 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))))) +#+nil (define-test trac.43 (:tag :trac) (assert-true @@ -174,11 +194,25 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))) +(define-test trac.43 + (:tag :trac) + (assert-true + (ext:with-temporary-stream (stream :direction :io :external-format :utf-8) + (dotimes (i 1000) + (write-char (code-char #x1234) stream)) + (file-position stream 0) + (let ((p0 (file-position stream)) + (ch (read-char stream))) + (unread-char ch stream) + (let ((p0* (file-position stream))) + (eql p0* p0)))))) + (define-test trac.50 (:tag :trac) (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) +#+nil (define-test trac.58 (:tag :trac) (assert-false @@ -198,6 +232,23 @@ failures) (delete-file path))))) +(define-test trac.58 + (:tag :trac) + (assert-false + (let (failures) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :external-format :utf-16) + (dotimes (i 300) + (write-char (code-char i) s))) + + (with-open-file (s path :direction :input :external-format :utf-16) + (dotimes (i 300) + (let ((ch (read-char s nil nil))) + (unless (= i (char-code ch)) + (push (list i ch (char-code ch)) failures))))) + failures)) + failures)) + (define-test trac.63 (:tag :trac) (assert-eql @@ -282,6 +333,7 @@ (assert-equal "A1234AAAA" (subseq (trac.70-test *trac.70* "a12345") 0 9))) +#+nil (define-test trac.79 (:tag :trac) ;; Create a temp file full of latin1 characters. @@ -301,12 +353,29 @@ (file-position s))))) (delete-file path))))) +(define-test trac.79 + (:tag :trac) + ;; Create a temp file full of latin1 characters. + (assert-equal + '(0 1) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (dotimes (k 255) + (write-char (code-char k) s))) + (with-open-file (s path :direction :input :external-format :latin1) + (list (file-position s) + (progn + (read-char s) + (file-position s))))))) + (define-test trac.80 (:tag :trac) ;; The following formats should not signal an error. (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) +#+nil (define-test trac.87.output (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -330,6 +399,27 @@ octets))) (delete-file path)))) +(define-test trac.87.output + (:tag :trac) + ;; Test that run-program accepts :element-type and produces the + ;; correct output. + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let* ((expected (stream:string-to-octets string :external-format :latin1)) + (octets (make-array (length expected) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :output :stream + :element-type '(unsigned-byte 8)))) + (read-sequence octets (ext:process-output proc)) + (assert-equalp + expected + octets))))) + +#+nil (define-test trac.87.input (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -354,6 +444,28 @@ octets output))) (delete-file path)))) + +(define-test trac.87.input + (:tag :trac) + ;; Test that run-program accepts :element-type and produces the + ;; correct input (and output). + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let ((octets (stream:string-to-octets string :external-format :latin1)) + (output (make-array (length string) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :input :stream + :output :stream + :element-type '(unsigned-byte 8)))) + (write-sequence octets (ext:process-input proc)) + (read-sequence output (ext:process-output proc)) + (assert-equalp + octets + output))))) (define-test trac.92 (:tag :trac) @@ -413,6 +525,7 @@ ;; Not quite what ticket 101 is about, but it came up in investigating ;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually ;; does. Previously, it did nothing. +#+nil (define-test trac.101 (:tag :trac) (assert-eql @@ -430,6 +543,20 @@ (close s) (delete-file *test-file*))))) +(define-test trac.101 + (:tag :trac) + (assert-eql + 0 + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open test-file)) + (file-length s))))) + (defun read-string-fn (str) (handler-case (let ((acc nil)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6698b2c13cc39a0c7c7a08… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6698b2c13cc39a0c7c7a08… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0