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/767a5f09aab6bbd29437ff1... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/767a5f09aab6bbd29437ff1... You're receiving this email because of your account on gitlab.common-lisp.net.