GitLab

at 2025-02-17T01:52:03+00:00

Fix #382:  Make command-line options be case-sensitive instead of case-insenstive

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
Fix #375:  Return the name of the temp file or directory

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
Document sap-ref-64 and signed-sap-ref-64

These functions have existed on almost all targets for many years now.

Fix #384:  Use correct header guard in elf.h

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
Fix #385:  Fix compiler warning about type mismatch between %p and the arg in Linux-os.c

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
Fix #365:  Add Unix interface to strerror and use in get-unix-error-msg

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
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]

Add recently closed issues to release notes

Don't need CI for this change
[SKIP-CI]

Merge branch 'master' into issue-381-cmucl-unix-os-specific

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.

 					 (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)

 ;;; 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)

   _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.

 (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)))

 \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

 \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.

     * ~~#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:

 "  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"

 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 ""

 "   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 ""

 #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

     {

  * 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 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)))))

+

+

Raymond Toy pushed to branch issue-381-cmucl-unix-os-specific at cmucl / cmucl

Commits:

10 changed files:

Changes: