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

[Git][cmucl/cmucl][issue-373-handle-temp-files] Update from HEAD to fix incorrect merge
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 9da10f58 by Raymond Toy at 2025-02-18T05:54:18-08:00 Update from HEAD to fix incorrect merge Just update tests/unix.lisp from HEAD because we messed up the merge previously and left some unmerged diffs in by accident. - - - - - 1 changed file: - tests/unix.lisp Changes: ===================================== tests/unix.lisp ===================================== @@ -7,19 +7,6 @@ (define-test mkstemp.name-returned (:tag :issues) -<<<<<<< HEAD - (let (fd name) - (unwind-protect - (progn - (multiple-value-setq (fd name) - (unix::unix-mkstemp "test-XXXXXX")) - (assert-true fd) - (assert-false (search "XXXXXX" name))) - (when fd - (unix:unix-unlink name))))) - -(define-test mkstemp.name-returned.2 -======= (let (fd filename) (unwind-protect (progn @@ -34,7 +21,6 @@ (unix:unix-unlink filename))))) (define-test mkstemp.non-ascii-name-returned ->>>>>>> master (:tag :issues) (let ((unix::*filename-encoding* :utf-8) fd name) @@ -76,7 +62,7 @@ (when name (unix:unix-rmdir name))))) -(define-test mkdtemp.name-returned.2 +(define-test mkdtemp.non-ascii-name-returned (:tag :issues) (let ((unix::*filename-encoding* :utf-8) name) @@ -101,3 +87,5 @@ (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/-/commit/9da10f582cd173e1569f3e8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9da10f582cd173e1569f3e8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 7 commits: Fix #379: Support GNU-style command line option names
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 67cb15e6 by Raymond Toy at 2025-02-15T15:34:50+00:00 Fix #379: Support GNU-style command line option names - - - - - 38da65c4 by Raymond Toy at 2025-02-15T15:34:50+00:00 Merge branch 'issue-379-gnu-style-options' into 'master' Fix #379: Support GNU-style command line option names Closes #379 See merge request cmucl/cmucl!266 - - - - - 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 - - - - - b7ca3635 by Raymond Toy at 2025-02-17T18:55:33-08:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - 7 changed files: - src/code/commandline.lisp - src/code/unix.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/lisp.c - tests/unix.lisp Changes: ===================================== src/code/commandline.lisp ===================================== @@ -109,7 +109,13 @@ (return (setf *command-line-switches* (nreverse *command-line-switches*)))) (let* ((position (position #\= (the simple-string str) :test #'char=)) - (switch (subseq (the simple-string str) 1 position)) + ;; Extract the name of the switch. The actual arg can be + ;; "-switch" or "--switch". + (switch (subseq (the simple-string str) + (position-if-not #'(lambda (c) + (char= c #\-)) + str) + position)) (value (if position (subseq (the simple-string str) (1+ position) (length (the simple-string str)))))) @@ -143,7 +149,14 @@ the switch. If no value was specified, then any following words are returned. If there are no following words, then t is returned. If the switch was not specified, then nil is returned." - (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname)) + (let* ((posn (position-if-not #'(lambda (ch) + (char= ch #\-)) + sname)) + ;; Strip up to 2 leading "-" to get the switch name. + ;; Otherwise, return the entire switch name. + (name (if (and posn (<= posn 2)) + (subseq sname posn) + sname)) (switch (find name *command-line-switches* :test #'string-equal :key #'cmd-switch-name))) @@ -177,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) @@ -230,12 +243,12 @@ (lisp::finish-standard-output-streams) (setf start next))))) -;; Docstrings should have lines longer than 72 characters so that we -;; can print out the docstrings nicely on one line for help. -;; | <-- char 72 +;; Docstrings MUST consist of simple text and punctuation and +;; newlines; no special markup is allowed. When help is printed, the +;; help string is automatically filled and wrapped to 80 columns. (defswitch "eval" #'eval-switch-demon "Evaluate the specified Lisp expression during the start up - sequence. the value of the form will not be printed unless it is + sequence. The value of the form will not be printed unless it is wrapped in a form that does output." "expression") @@ -325,7 +338,7 @@ (defswitch "quiet" nil "Causes Lisp to start up silently, disabling printing of the herald - and causing most unnecessary noise, like GC messages,load messages, + and causing most unnecessary noise, like GC messages, load messages, etc. to be suppressed.") (defswitch "debug-lisp-search" nil @@ -338,7 +351,8 @@ (defun help-switch-demon (switch) (declare (ignore switch)) - (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) + (format t (intl:gettext "~&Usage: ~A <options> [-- [app-args]*]~2%") + *command-line-utility-name*) (flet ((get-words (s) (declare (string s)) @@ -366,7 +380,12 @@ :key #'car)) (destructuring-bind (name doc arg) s - (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) + ;; Print both -switch and --switch, and the optional arg + ;; value. + (format t " -~A|--~A ~@[~A~]~%" + name name + (if arg (intl:gettext arg))) + ;; Poor man's formatting of the help string (let ((*print-right-margin* 80)) ;; Extract all the words from the string and print them out @@ -392,9 +411,6 @@ (defswitch "help" #'help-switch-demon "Print out the command line options and exit") -(defswitch "-help" #'help-switch-demon - "Same as -help.") - (defun version-switch-demon (switch) (declare (ignore switch)) (format t "~A~%" (lisp-implementation-version)) @@ -406,8 +422,3 @@ ;; it out so the user knows about it. (defswitch "version" #'version-switch-demon "Prints the cmucl version and exits, without loading the lisp core.") - -;; Make --version work for the benefit of those who are accustomed to -;; GNU software. -(defswitch "-version" #'version-switch-demon - "Prints the cmucl version and exits; same as -version") ===================================== src/code/unix.lisp ===================================== @@ -2921,8 +2921,10 @@ (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. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (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)) @@ -2930,8 +2932,10 @@ (progn ;; Copy out the alien bytes and convert back ;; to a lisp string. - (dotimes (k length) - (setf (aref octets k) (deref buffer k))) + (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)))))) @@ -2955,8 +2959,12 @@ (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. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (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) ===================================== src/general-info/release-21f.md ===================================== @@ -119,6 +119,7 @@ public domain. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` * ~~#367~~ Add stream:string-count-octets to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#379~~ Support GNU-style command-line option names * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1440,16 +1440,17 @@ 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/i18n/locale/cmucl.pot ===================================== @@ -6060,7 +6060,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Evaluate the specified Lisp expression during the start up\n" -" sequence. the value of the form will not be printed unless it is\n" +" sequence. The value of the form will not be printed unless it is\n" " wrapped in a form that does output." msgstr "" @@ -6182,7 +6182,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Causes Lisp to start up silently, disabling printing of the herald\n" -" and causing most unnecessary noise, like GC messages,load messages,\n" +" and causing most unnecessary noise, like GC messages, load messages,\n" " etc. to be suppressed." msgstr "" @@ -6197,25 +6197,17 @@ msgid "Specify the unidata.bin file to be used." msgstr "" #: src/code/commandline.lisp -msgid "~&Usage: ~A <options>~2%" +msgid "~&Usage: ~A <options> [-- [app-args]*]~2%" msgstr "" #: src/code/commandline.lisp msgid "Print out the command line options and exit" msgstr "" -#: src/code/commandline.lisp -msgid "Same as -help." -msgstr "" - #: src/code/commandline.lisp msgid "Prints the cmucl version and exits, without loading the lisp core." msgstr "" -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits; same as -version" -msgstr "" - #: src/code/env-access.lisp msgid "" "Returns information about the symbol VAR in the lexical environment ENV.\n" ===================================== src/lisp/lisp.c ===================================== @@ -460,6 +460,41 @@ core_failure(const char* core, const char* argv[]) exit(1); } +/* + * Match the actual command line option "arg" with the arg name in + * "argname". The option matches if it is exacty the arg name + * prefixed by either one or two "-" characters. + * + * Returns non-zero if it matches. + */ +int match_option(const char* arg, const char* argname) +{ + if ((strlen(arg) < 2) || strlen(argname) < 1) { + /* + * The actual arg must be at least 2 characters. The argname + * must have at least 1. + */ + return 0; + } + + /* Must start with a "-" */ + if (arg[0] != '-') { + return 0; + } + + if (strcmp(arg + 1, argname) == 0) { + /* We have "-" followed by the argname. That's a match. */ + return 1; + } + + if ((arg[1] == '-') && (strcmp(arg + 2, argname) == 0)) { + /* We have "--" followed by the argname. That's a match. */ + return 1; + } + + return 0; +} + int main(int argc, const char *argv[], const char *envp[]) { @@ -529,7 +564,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-core") == 0) { + if (match_option(arg, "core")) { if (builtin_image_flag) { fprintf(stderr, "Warning: specifying a core file with an executable image is unusual,\nbut should work.\n"); @@ -543,87 +578,98 @@ main(int argc, const char *argv[], const char *envp[]) core = *++argptr; if (core == NULL) { fprintf(stderr, - "-core must be followed by the name of the core file to use.\n"); + "%s must be followed by the name of the core file to use.\n", + arg); exit(1); } - } else if (strcmp(arg, "-lib") == 0) { + } else if (match_option(arg, "lib")) { lib = *++argptr; if (lib == NULL) { fprintf(stderr, - "-lib must be followed by a string denoting the CMUCL library path.\n"); + "%s must be followed by a string denoting the CMUCL library path.\n", + arg); exit(1); } - } else if (strcmp(arg, "-read-only-space-size") == 0) { + } else if (match_option(arg, "read-only-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-read-only-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } read_only_space_size = atoi(str) * 1024 * 1024; if (read_only_space_size > READ_ONLY_SPACE_SIZE) { fprintf(stderr, - "-read-only-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, READ_ONLY_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); read_only_space_size = READ_ONLY_SPACE_SIZE; } - } else if (strcmp(arg, "-static-space-size") == 0) { + } else if (match_option(arg, "static-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-static-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } static_space_size = atoi(str) * 1024 * 1024; if (static_space_size > STATIC_SPACE_SIZE) { fprintf(stderr, - "-static-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, STATIC_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); static_space_size = STATIC_SPACE_SIZE; } - } else if (strcmp(arg, "-binding-stack-size") == 0) { + } else if (match_option(arg, "binding-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-binding-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } binding_stack_size = atoi(str) * 1024 * 1024; if (binding_stack_size > BINDING_STACK_SIZE) { fprintf(stderr, - "-binding-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, BINDING_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); binding_stack_size = BINDING_STACK_SIZE; } - } else if (strcmp(arg, "-control-stack-size") == 0) { + } else if (match_option(arg, "control-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-control-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } control_stack_size = atoi(str) * 1024 * 1024; if (control_stack_size > CONTROL_STACK_SIZE) { fprintf(stderr, - "-control-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, CONTROL_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); control_stack_size = CONTROL_STACK_SIZE; } - } else if (strcmp(arg, "-dynamic-space-size") == 0) { + } else if (match_option(arg, "dynamic-space-size")) { const char *str; str = *++argptr; if (str == NULL) { fprintf(stderr, - "-dynamic-space-size must be followed by the size to use in MBytes.\n"); + "%s must be followed by the size to use in MBytes.\n", + arg); exit(1); } #ifndef sparc @@ -669,15 +715,16 @@ main(int argc, const char *argv[], const char *envp[]) #endif if (dynamic_space_size > DYNAMIC_SPACE_SIZE) { fprintf(stderr, - "-dynamic-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, DYNAMIC_SPACE_SIZE / (1024 * 1024UL)); exit(1); } - } else if (strcmp(arg, "-monitor") == 0) { + } else if (match_option(arg, "monitor")) { monitor = TRUE; - } else if (strcmp(arg, "-debug-lisp-search") == 0) { + } else if (match_option(arg, "debug-lisp-search")) { debug_lisp_search = TRUE; - } else if (strcmp(arg, "-unidata") == 0) { + } else if (match_option(arg, "unidata")) { unidata = *++argptr; } else if ((strcmp(arg, "-version") == 0) || (strcmp(arg, "--version") == 0)) { @@ -904,7 +951,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-batch") == 0) + if (match_option(arg, "batch")) SetSymbolValue(BATCH_MODE, T); } ===================================== tests/unix.lisp ===================================== @@ -7,6 +7,7 @@ (define-test mkstemp.name-returned (:tag :issues) +<<<<<<< HEAD (let (fd name) (unwind-protect (progn @@ -18,6 +19,22 @@ (unix:unix-unlink name))))) (define-test mkstemp.name-returned.2 +======= + (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 +>>>>>>> master (:tag :issues) (let ((unix::*filename-encoding* :utf-8) fd name) @@ -47,28 +64,6 @@ (assert-false fd) (assert-true (and (integerp errno) (plusp errno))))) -;; Darwin accepts this template. It creates the file "test-". -#-darwin -(define-test mkstemp.bad-template - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-") - ;; The template doesn't have enough X's 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))))) - -;; Darwin accepts this template and just creates the file -;; "test-XXXXXXa". (The next call would return an error.) -#-darwin -(define-test mkstemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-XXXXXXa") - ;; The template doesn't end in X's - (assert-false fd) - (assert-true (and (integerp errno) (plusp errno))))) - (define-test mkdtemp.name-returned (:tag :issues) (let (name) @@ -106,23 +101,3 @@ (unix::unix-mkdtemp "random-dir/dir-XXXXXX") (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) - -;; Darwin allows any number of X's. -#-darwin -(define-test mkdtemp.bad-template - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-") - ;; No X's in template, like for mkstemp.bad-template test. - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) - -;; Same issue with mkdtemp as with mkstemp above on Darwin. -#-darwin -(define-test mkdtemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-XXXXXXa") - ;; Template doesn't end in X's - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/578efc93eb195def77a847… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/578efc93eb195def77a847… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #375: Return the name of the temp file or directory
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 3 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - + tests/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2907,28 +2907,71 @@ (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))))))) ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1440,16 +1440,17 @@ 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 "" ===================================== 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/ee6690706cab10fa066030… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ee6690706cab10fa066030… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Add with-temporary-file to create a temporary file
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 578efc93 by Raymond Toy at 2025-02-17T17:48:37-08:00 Add with-temporary-file to create a temporary file Use mkstemp to create a file and return the file name. On completion, the file is deleted. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -658,6 +658,21 @@ (close ,s) (unix:unix-close ,fd)))))) +;;; WITH-TEMPORARY-FILE -- Public +(defmacro with-temporary-file ((filename) + &parse-body (forms decls)) + (let ((fd (gensym "FD-"))) + `(let (,filename) + (unwind-protect + (let (,fd) + (multiple-value-setq (,fd ,filename) + (unix::unix-mkstemp "/tmp/cmucl-temp-file-XXXXXX")) + (unix:unix-close ,fd) + (locally ,@decls + ,@forms)) + (delete-file ,filename))))) + + ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname template) &parse-body (forms decls)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/578efc93eb195def77a847a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/578efc93eb195def77a847a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-375-mkstemp-return-filename] 2 commits: Fix typo in mkstemp.name-returned
by Raymond Toy (＠rtoy) 17 Feb '25

17 Feb '25

Raymond Toy pushed to branch issue-375-mkstemp-return-filename at cmucl / cmucl Commits: 239afca7 by Raymond Toy at 2025-02-16T19:16:57-08:00 Fix typo in mkstemp.name-returned We were trying to unlink `name`, but it should be `filename`. - - - - - 93ec7d20 by Raymond Toy at 2025-02-16T19:17:55-08:00 Forgot one place to use system-area-copy and fix typo in another call. Replace one loop with system-area-copy in unix-mkstemp. Fix typo in system-area-copy in unix-mkdtemp because we forgot the dst offset arg. - - - - - 2 changed files: - src/code/unix.lisp - tests/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2932,8 +2932,10 @@ (progn ;; Copy out the alien bytes and convert back ;; to a lisp string. - (dotimes (k length) - (setf (aref octets k) (deref buffer k))) + (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)))))) @@ -2959,7 +2961,7 @@ ;; 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) + (alien-sap buffer) 0 (* length vm:byte-bits))) (setf (deref buffer length) 0) ===================================== tests/unix.lisp ===================================== @@ -18,7 +18,7 @@ (assert-false (equalp filename template)) (assert-true (>= 5 (mismatch filename template)))))) (when fd - (unix:unix-unlink name))))) + (unix:unix-unlink filename))))) (define-test mkstemp.non-ascii-name-returned (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5039239f52588ce0756843… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5039239f52588ce0756843… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-375-mkstemp-return-filename] 10 commits: Forgot to export "STRING-OCTET-COUNT" from STREAM package
by Raymond Toy (＠rtoy) 17 Feb '25

17 Feb '25

Raymond Toy pushed to branch issue-375-mkstemp-return-filename at cmucl / cmucl Commits: d80924da by Raymond Toy at 2025-02-12T15:54:22-08:00 Forgot to export "STRING-OCTET-COUNT" from STREAM package - - - - - 009e1382 by Raymond Toy at 2025-02-13T16:00:10+00:00 Fix #363: Add version number to files and directories - - - - - 5269a666 by Raymond Toy at 2025-02-13T16:00:10+00:00 Merge branch 'issue-363-add-version-number' into 'master' Fix #363: Add version number to files and directories Closes #363 See merge request cmucl/cmucl!261 - - - - - 67cb15e6 by Raymond Toy at 2025-02-15T15:34:50+00:00 Fix #379: Support GNU-style command line option names - - - - - 38da65c4 by Raymond Toy at 2025-02-15T15:34:50+00:00 Merge branch 'issue-379-gnu-style-options' into 'master' Fix #379: Support GNU-style command line option names Closes #379 See merge request cmucl/cmucl!266 - - - - - 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 - - - - - f91dc2ec by Raymond Toy at 2025-02-16T18:52:01-08:00 Remove tests that don't work on Darwin As suggested in the review, we're not really depending on these test that work on Linux but not on Darwin. Thus, remove these tests. - - - - - 23fc7beb by Raymond Toy at 2025-02-16T18:55:16-08:00 Merge branch 'master' into issue-375-mkstemp-return-filename - - - - - 5039239f by Raymond Toy at 2025-02-16T19:01:36-08:00 Update pot file for changed docstrings for mkdtemp. - - - - - 25 changed files: - .gitlab-ci.yml - bin/build-utils.sh - bin/build.sh - bin/cross-build-world.sh - + bin/git-version.sh - bin/load-world.sh - bin/make-dist.sh - bin/make-extra-dist.sh - bin/make-main-dist.sh - bin/make-src-dist.sh - bin/run-unit-tests.sh - src/code/commandline.lisp - src/code/default-site-init.lisp - src/code/exports.lisp - src/compiler/arm/parms.lisp - src/compiler/ppc/parms.lisp - src/compiler/sparc/parms.lisp - src/compiler/x86/parms.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-bsd-os.pot - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/lisp.c - src/tools/worldload.lisp - tests/unix.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -51,9 +51,9 @@ linux:build: # instead of clang. - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - # 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 -V `git describe --dirty` -I dist linux-4 + # When the result of `git describe` cannot be used as a version + # string, an alternative can be provided with the -V flag + - bin/make-dist.sh -I dist linux-4 linux:cross-build: stage: build @@ -80,8 +80,8 @@ linux:cross-build: - bin/create-target.sh xtarget - bin/create-target.sh xcross - bin/cross-build-world.sh -crl xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp dist/bin/lisp - - bin/build.sh -b xlinux $bootstrap -R -C "" -o xtarget/lisp/lisp - - bin/make-dist.sh -V `git describe --dirty` -I xdist xlinux-4 + - bin/build.sh -b xlinux $bootstrap -R -C "" -o "xtarget/lisp/lisp -lib xtarget/lisp" + - bin/make-dist.sh -I xdist xlinux-4 linux:test: stage: test @@ -194,9 +194,9 @@ osx:build: # Regular build using the cross-compiled result or snapshot. # Need /opt/local/bin to get msgmerge and msgfmt programs. - PATH=/opt/local/bin:$PATH bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp - # Use -V to specify the version in case some tag makes git + # 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 -V `git describe --dirty` -I dist darwin-4 + - bin/make-dist.sh -I dist darwin-4 osx:test: stage: test @@ -319,9 +319,9 @@ opensuse:build: # instead of clang. - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - # Use -V to specify the version in case some tag makes git + # 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 -V `git describe --dirty` -I dist linux-4 + - bin/make-dist.sh -I dist linux-4 opensuse:test: stage: test ===================================== bin/build-utils.sh ===================================== @@ -16,7 +16,7 @@ TARGET="`echo $1 | sed 's:/*$::'`" shift $TARGET/lisp/lisp \ - -noinit -nositeinit -batch "$@" <<EOF || exit 3 + -lib $TARGET/lisp -noinit -nositeinit -batch "$@" <<EOF || exit 3 (in-package :cl-user) (setf lisp::*enable-package-locked-errors* nil) ===================================== bin/build.sh ===================================== @@ -110,6 +110,13 @@ case `uname -s` in esac ;; esac +# Set default version and generate lisp/cmucl-version.h +DEFAULT_VERSION="`bin/git-version.sh`" +export DEFAULT_VERISON +echo DEFAULT_VERSION = $DEFAULT_VERSION + +bin/git-version.sh -f > src/lisp/cmucl-version.h + export LANG=en_US.UTF-8 buildit () @@ -142,9 +149,10 @@ buildit () then $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } fi - $TOOLDIR/load-world.sh $TARGET "$VERSION" || { echo "Failed: $TOOLDIR/load-world.sh"; exit 1; } + $TOOLDIR/load-world.sh $TARGET || { echo "Failed: $TOOLDIR/load-world.sh"; exit 1; } + + $TARGET/lisp/lisp -lib $TARGET/lisp -batch -noinit -nositeinit < /dev/null || { echo "Failed: $TARGET/lisp/lisp -batch -noinit"; exit 1; } - $TARGET/lisp/lisp -batch -noinit -nositeinit < /dev/null || { echo "Failed: $TARGET/lisp/lisp -batch -noinit"; exit 1; } return 0; fi } @@ -221,7 +229,7 @@ buildit bootfiles= TARGET=$BASE-3 -OLDLISP="${BASE}-2/lisp/lisp $OLDLISPFLAGS" +OLDLISP="${BASE}-2/lisp/lisp -lib ${BASE}-2/lisp $OLDLISPFLAGS" ENABLE=$ENABLE3 BUILD=2 @@ -232,7 +240,7 @@ buildit TARGET=$BASE-4 CLEAN_FLAGS="-K all" -OLDLISP="${BASE}-3/lisp/lisp $OLDLISPFLAGS" +OLDLISP="${BASE}-3/lisp/lisp -lib ${BASE}-3/lisp $OLDLISPFLAGS" ENABLE=$ENABLE4 if [ "${BUILD_POT}" = "yes" ]; then @@ -250,7 +258,7 @@ buildit # Asdf and friends are part of the base install, so we need to build # them now. -$TARGET/lisp/lisp -noinit -nositeinit -batch << EOF || exit 3 +$TARGET/lisp/lisp -lib $TARGET/lisp -noinit -nositeinit -batch << EOF || exit 3 (in-package :cl-user) (setf (ext:search-list "target:") '("$TARGET/" "src/")) @@ -270,7 +278,7 @@ EOF if [ "$SKIPUTILS" = "no" ]; then - OLDLISP="${BASE}-4/lisp/lisp $OLDLISPFLAGS" + OLDLISP="${BASE}-4/lisp/lisp -lib ${BASE}-4/lisp $OLDLISPFLAGS" time $TOOLDIR/build-utils.sh $TARGET fi ===================================== bin/cross-build-world.sh ===================================== @@ -138,10 +138,11 @@ EOF if [ "$BUILD_RUNTIME" = "yes" ]; then echo Building runtime + bin/git-version.sh -f > src/lisp/cmucl-version.h (cd $TARGET/lisp; ${MAKE}) fi if [ "$LOAD_KERNEL" = "yes" ]; then echo Load kernel.core - bin/load-world.sh -p $TARGET cross-compiled + bin/load-world.sh -p $TARGET fi ===================================== bin/git-version.sh ===================================== @@ -0,0 +1,39 @@ +#!/bin/sh + +# If FILE=yes, print out the version as a C file #define. Otherwise, +# just print the version to stdout and exit. +FILE="" + +while getopts "f" arg; do + case $arg in + f) FILE=yes + ;; + esac +done + +# Script to determine the cmucl version based on git describe +GIT_HASH="`(git describe --dirty 2>/dev/null || git describe 2>/dev/null)`" + +if [ `expr "X$GIT_HASH" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]'` != 0 ]; then + # The git hash looks like snapshot-yyyy-mm-<stuff>. Remove the + # "snapshot-" part. + DEFAULT_VERSION=`expr "$GIT_HASH" : "snapshot-$.*$"` +elif [ `expr "X$GIT_HASH" : 'X[0-9][0-9][a-f]'` != 0 ]; then + # The git hash looks like a release which is 3 hex digits. Use it as is. + DEFAULT_VERSION="${GIT_HASH}" +fi + +if [ -z "$FILE" ]; then + echo $DEFAULT_VERSION +else + cat <<EOF +/* + * Cmucl version + * + * DO NOT EDIT! This file is auto-generated via bin/git-version.sh. + */ + +#define CMUCL_VERSION "$DEFAULT_VERSION" +EOF +fi + ===================================== bin/load-world.sh ===================================== @@ -2,30 +2,14 @@ usage() { - echo "load-world.sh [-?p] target-directory [version-string]" + echo "load-world.sh [-?p] target-directory" echo " -p Skip loading of PCL (Mostly for cross-compiling)" echo " -? This help" - echo " If the version-string is not given, the current date and time is used" exit 1 } SKIP_PCL= NO_PCL_FEATURE= -# Default version is the date with the git hash. Older versions of -# git don't support --dirty, but the output in that case is what we -# want (except for ending with "dirty"), so we're set. -GIT_HASH="`(cd src; git describe --dirty 2>/dev/null || git describe 2>/dev/null)`" - -# If the git hash looks like a snapshot tag or release, don't add the date. -VERSION="`date '+%Y-%m-%d %H:%M:%S'`${GIT_HASH:+ $GIT_HASH}" -if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then - VERSION="${GIT_HASH}" -fi - -if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then - VERSION="${GIT_HASH}" -fi -echo $VERSION while getopts "p" arg do ===================================== bin/make-dist.sh ===================================== @@ -94,21 +94,6 @@ def_arch_os () { # Figure out the architecture and OS in case options aren't given def_arch_os -# Choose a version based on the git hash as the default version. We -# only compute a default if the git hash looks like a snapshot -# ("snapshot-yyyy-mm") or a release number.. -GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`" - -echo GIT_HASH = ${GIT_HASH} - -if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then - DEFAULT_VERSION=`expr "${GIT_HASH}" : "snapshot-$.*$"` -fi - -if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then - DEFAULT_VERSION="${GIT_HASH}" -fi - # Default compression is -J (xz). These variables are passed to the # other scripts via the environmen, so export them. COMPRESS=-J @@ -159,17 +144,6 @@ if [ -n "$COMPRESS_ARG" ]; then esac fi -if [ -z "$VERSION" ]; then - # If a default version exists, use it. Otherwise this is an - # error---at least one of these must not be empty. - if [ -z "${DEFAULT_VERSION}" ]; then - echo "Version (-V) must be specified because default version cannot be determined." - usage - else - VERSION=${DEFAULT_VERSION} - fi -fi - if [ ! -d "$1" ] then echo "$1 isn't a directory" @@ -190,10 +164,24 @@ fi TARGET="`echo $1 | sed 's:/*$::'`" -if [ -n "$INSTALL_DIR" ]; then - VERSION="today" +# Choose a version based on the git hash as the default version. We +# only compute a default if the git hash looks like a snapshot +# ("snapshot-yyyy-mm") or a release number.. +DEFAULT_VERSION="`$TARGET/lisp/lisp --version`" + +if [ -z "$VERSION" ]; then + # If a default version exists, use it. Otherwise this is an + # error---at least one of these must not be empty. + if [ -z "${DEFAULT_VERSION}" ]; then + echo "Version (-V) must be specified because default version cannot be determined." + usage + else + VERSION=${DEFAULT_VERSION} + fi fi +echo INSTALL_DIR = $INSTALL_DIR + echo cmucl-$VERSION-$ARCH-$OS ROOT=`dirname $0` ===================================== bin/make-extra-dist.sh ===================================== @@ -66,6 +66,8 @@ VERSION=$2 ARCH=$3 OS=$4 +CMUCLLIBVER="lib/cmucl/$VERSION" + case $ARCH in x86*) FASL="sse2f" ;; sparc*) FASL=sparcf ;; @@ -90,41 +92,29 @@ if [ -z "$INSTALL_DIR" ]; then fi echo Installing extra components -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/subsystems +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/subsystems -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib for ext in $FASL do install ${GROUP} ${OWNER} -m 0644 $TARGET/clx/clx-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ install ${GROUP} ${OWNER} -m 0644 $TARGET/hemlock/hemlock-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ install ${GROUP} ${OWNER} -m 0644 $TARGET/interface/clm-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ done -# Not sure we really need these, but we'll install them in the -# ext-formats directory. (Should they go somewhere else?) -#install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/ext-formats -#for f in src/i18n/NameAliases.txt src/i18n/UnicodeData.txt -#do -# echo $f -# install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ -#done - -# install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/fonts/ -# install ${GROUP} ${OWNER} -m 0644 misc/8x13u.snf misc/fonts.dir \ -# $DESTDIR/lib/cmucl/lib/fonts/ install ${GROUP} ${OWNER} -m 0644 src/hemlock/XKeysymDB \ src/hemlock/hemlock11.cursor src/hemlock/hemlock11.mask \ $TARGET/hemlock/spell-dictionary.bin \ - $DESTDIR/lib/cmucl/lib/ -install ${GROUP} ${OWNER} -m 0755 src/hemlock/mh-scan $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ +install ${GROUP} ${OWNER} -m 0755 src/hemlock/mh-scan $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0755 $TARGET/motif/server/motifd \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ # Install the contrib stuff. Create the directories and then copy the files. # @@ -132,39 +122,29 @@ install ${GROUP} ${OWNER} -m 0755 $TARGET/motif/server/motifd \ # these directories. for d in `(cd src; find contrib -type d -print | grep -v "asdf\|defsystem")` do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/$d + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/$d done for f in `(cd src/contrib; find . -type f -print | grep -v "asdf\|defsystem\|unix")` do - FILE=`basename $f` DIR=`dirname $f` - install ${GROUP} ${OWNER} -m 0644 src/contrib/$f $DESTDIR/lib/cmucl/lib/contrib/$DIR + install ${GROUP} ${OWNER} -m 0644 src/contrib/$f $DESTDIR/$CMUCLLIBVER/lib/contrib/$DIR done # Install all the locale data. for d in `(cd src/i18n/; find locale -type d -print)` do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/$d + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/$d done # Install mo files. Ignore any emacs-style backup files. for f in `(cd $TARGET/i18n; find locale -type f -print | grep -v '~.*~\|.*~')` do - FILE=`basename $f` DIR=`dirname $f` - install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/lib/cmucl/lib/$DIR + install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/$CMUCLLIBVER/lib/$DIR done -# Install po files. (Do we really need to distribute the po files?) -#for f in `(cd $TARGET/i18n; find locale -type f -print | grep -v '~.*~\|.*~')` -#do -# FILE=`basename $f` -# DIR=`dirname $f` -# install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/lib/cmucl/lib/$DIR -#done - if [ -z "$INSTALL_DIR" ]; then sync ; sleep 1 ; sync ; sleep 1 ; sync echo Tarring extra components ===================================== bin/make-main-dist.sh ===================================== @@ -64,14 +64,24 @@ then exit 2 fi -DESTDIR=${INSTALL_DIR:-release-$$} -DOCDIR=${DOCDIR:-doc/cmucl} -MANDIR=${MANDIR:-man/man1} -TARGET="`echo $1 | sed 's:/*$::'`" VERSION=$2 ARCH=$3 OS=$4 +# Where to install the main library of cmucl files +CMUCLLIBVER="lib/cmucl/$VERSION" + +# Where to install everything +DESTDIR=${INSTALL_DIR:-release-$$} + +# Where to install docs +DOCDIR=${DOCDIR:-share/cmucl/$VERSION/doc} + +# Where to install man pages +MANDIR=${MANDIR:-share/man/man1} + +TARGET="`echo $1 | sed 's:/*$::'`" + # Core file to look for. CORE=lisp.core case $ARCH in @@ -123,52 +133,59 @@ fi # set -x echo Installing main components install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/bin -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/subsystems -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/ext-formats +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/subsystems +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/ext-formats install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/${DOCDIR} install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/${MANDIR} -install ${GROUP} ${OWNER} -m 0755 $TARGET/lisp/lisp $DESTDIR/bin/ +install ${GROUP} ${OWNER} -m 0755 $TARGET/lisp/lisp $DESTDIR/bin/lisp-$VERSION +# Install symlink for lisp +(cd $DESTDIR/bin; ln -fs lisp-$VERSION lisp) +# Install symlink for man pages +(cd $DESTDIR/${MANDIR} + ln -fs lisp-$VERSION.1 lisp.1 + ln -fs cmucl-$VERSION.1 cmucl.1) + if [ "$EXECUTABLE" = "true" ] then - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.a $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-init.o $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-final.o $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0755 src/tools/linker.sh $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.a $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-init.o $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-final.o $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0755 src/tools/linker.sh $DESTDIR/$CMUCLLIBVER/lib/ if [ -f src/tools/$SCRIPT-cmucl-linker-script ]; then - install ${GROUP} ${OWNER} -m 0755 src/tools/$SCRIPT-cmucl-linker-script $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0755 src/tools/$SCRIPT-cmucl-linker-script $DESTDIR/$CMUCLLIBVER/lib/ fi fi for corefile in $TARGET/lisp/$CORE do - install ${GROUP} ${OWNER} -m 0644 $corefile $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $corefile $DESTDIR/$CMUCLLIBVER/lib/ done install ${GROUP} ${OWNER} -m 0755 src/tools/load-foreign.csh src/tools/config \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 src/tools/config.lisp \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 src/code/default-site-init.lisp \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.nm $TARGET/lisp/lisp.map \ - $TARGET/lisp/internals.h $TARGET/lisp/internals.inc $DESTDIR/lib/cmucl/ -install ${GROUP} ${OWNER} -m 0755 src/tools/sample-wrapper $DESTDIR/lib/cmucl/ + $TARGET/lisp/internals.h $TARGET/lisp/internals.inc $DESTDIR/$CMUCLLIBVER/ +install ${GROUP} ${OWNER} -m 0755 src/tools/sample-wrapper $DESTDIR/$CMUCLLIBVER/ for f in gray-streams gray-compat simple-streams iodefs do - install ${GROUP} ${OWNER} -m 0644 $TARGET/pcl/$f-library.$FASL $DESTDIR/lib/cmucl/lib/subsystems/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/pcl/$f-library.$FASL $DESTDIR/$CMUCLLIBVER/lib/subsystems/ done for f in src/pcl/simple-streams/external-formats/*.lisp src/pcl/simple-streams/external-formats/aliases src/i18n/unidata.bin do - install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ + install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/$CMUCLLIBVER/lib/ext-formats/ done # set -x # Create the directories for asdf and defsystem for f in asdf defsystem asdf/doc do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib/$f done case `uname -s` in @@ -176,34 +193,34 @@ case `uname -s` in *) UCONTRIB="unix" ;; esac -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/unix -install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/lib/cmucl/lib/contrib/unix -install ${GROUP} ${OWNER} -m 0644 src/contrib/load-unix.lisp $DESTDIR/lib/cmucl/lib/contrib -install ${GROUP} ${OWNER} -m 0644 src/contrib/unix/${UCONTRIB}.lisp $DESTDIR/lib/cmucl/lib/contrib/unix +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib/unix +install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/$CMUCLLIBVER/lib/contrib/unix +install ${GROUP} ${OWNER} -m 0644 src/contrib/load-unix.lisp $DESTDIR/$CMUCLLIBVER/lib/contrib +install ${GROUP} ${OWNER} -m 0644 src/contrib/unix/${UCONTRIB}.lisp $DESTDIR/$CMUCLLIBVER/lib/contrib/unix # Copy the source files for asdf and defsystem for f in `(cd src; find contrib/asdf contrib/defsystem -type f -print | grep -v CVS)` do - install ${GROUP} ${OWNER} -m 0644 src/$f $DESTDIR/lib/cmucl/lib/$f + install ${GROUP} ${OWNER} -m 0644 src/$f $DESTDIR/$CMUCLLIBVER/lib/$f done # Install the fasl files for asdf and defsystem for f in asdf defsystem do - install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f + install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/$CMUCLLIBVER/lib/contrib/$f done # Install the docs for asdf for f in src/contrib/asdf/doc/* do base=`basename $f` - install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/contrib/asdf/doc/$base + install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/$CMUCLLIBVER/lib/contrib/asdf/doc/$base done install ${GROUP} ${OWNER} -m 0644 src/general-info/cmucl.1 \ - $DESTDIR/${MANDIR}/ + $DESTDIR/${MANDIR}/cmucl-$VERSION.1 install ${GROUP} ${OWNER} -m 0644 src/general-info/lisp.1 \ - $DESTDIR/${MANDIR}/ + $DESTDIR/${MANDIR}/lisp-$VERSION.1 install ${GROUP} ${OWNER} -m 0644 src/general-info/README $DESTDIR/${DOCDIR} if [ -f src/general-info/release-$VERSION.txt ] then ===================================== bin/make-src-dist.sh ===================================== @@ -52,12 +52,18 @@ else VERSION="`date '+%Y-%m-%d-%H:%M:%S'`" fi +DESTDIR=${INSTALL_DIR:-release-$$} + echo Creating source distribution GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/share/cmucl/$VERSION/ +install ${GROUP} ${OWNER} -m 0755 bin/run-unit-tests.sh $DESTDIR/bin +${GTAR} ${GTAR_OPTIONS} -cf - src tests | (cd $DESTDIR/share/cmucl/$VERSION; ${GTAR} xf -) if [ -z "$INSTALL_DIR" ]; then # echo " Compressing with $ZIP" - ${GTAR} ${GTAR_OPTIONS} ${COMPRESS} -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT bin src tests + ls $DESTDIR/share/cmucl/$VERSION/ + ${GTAR} ${GTAR_OPTIONS} ${COMPRESS} -C $DESTDIR -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT share/cmucl/$VERSION/src else # Install in the specified directory - ${GTAR} ${GTAR_OPTIONS} -cf - bin src tests | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) + ${GTAR} ${GTAR_OPTIONS} -cf - src tests | (cd $DESTDIR/share/cmucl/$VERSION; ${GTAR:-tar} xf -) fi ===================================== bin/run-unit-tests.sh ===================================== @@ -6,7 +6,8 @@ # then just those tests are run. usage() { - echo "run-tests.sh [?] [-l lisp] [tests]" + echo "run-tests.sh [?] [-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 " -? This help message" echo "" @@ -23,10 +24,11 @@ usage() { } LISP=lisp -while getopts "h?l:" arg +while getopts "h?l:d:" arg do case $arg in l) LISP=$OPTARG ;; + d) TESTDIR=$OPTARG ;; \?) usage ;; esac done @@ -47,14 +49,21 @@ function cleanup { trap cleanup EXIT +if [ -n "${TESTDIR}" ]; then + TESTDIRARG=" :test-directory \"$TESTDIR/\"" +else + TESTDIR="tests/" + TESTDIRARG="" +fi # Compile up the C file that is used for testing alien funcalls to # functions that return integer types of different lengths. We use # gcc since clang isn't always available. -(cd tests; gcc -m32 -O3 -c test-return.c) +(cd "$TESTDIR"; 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 tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-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="" @@ -63,6 +72,6 @@ else new=`echo $f | tr '[a-z]' '[A-Z]'` result="$result "\"$new-TESTS\" done - $LISP -nositeinit -noinit -load tests/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" fi ===================================== src/code/commandline.lisp ===================================== @@ -109,7 +109,13 @@ (return (setf *command-line-switches* (nreverse *command-line-switches*)))) (let* ((position (position #\= (the simple-string str) :test #'char=)) - (switch (subseq (the simple-string str) 1 position)) + ;; Extract the name of the switch. The actual arg can be + ;; "-switch" or "--switch". + (switch (subseq (the simple-string str) + (position-if-not #'(lambda (c) + (char= c #\-)) + str) + position)) (value (if position (subseq (the simple-string str) (1+ position) (length (the simple-string str)))))) @@ -143,7 +149,14 @@ the switch. If no value was specified, then any following words are returned. If there are no following words, then t is returned. If the switch was not specified, then nil is returned." - (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname)) + (let* ((posn (position-if-not #'(lambda (ch) + (char= ch #\-)) + sname)) + ;; Strip up to 2 leading "-" to get the switch name. + ;; Otherwise, return the entire switch name. + (name (if (and posn (<= posn 2)) + (subseq sname posn) + sname)) (switch (find name *command-line-switches* :test #'string-equal :key #'cmd-switch-name))) @@ -177,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) @@ -230,12 +243,12 @@ (lisp::finish-standard-output-streams) (setf start next))))) -;; Docstrings should have lines longer than 72 characters so that we -;; can print out the docstrings nicely on one line for help. -;; | <-- char 72 +;; Docstrings MUST consist of simple text and punctuation and +;; newlines; no special markup is allowed. When help is printed, the +;; help string is automatically filled and wrapped to 80 columns. (defswitch "eval" #'eval-switch-demon "Evaluate the specified Lisp expression during the start up - sequence. the value of the form will not be printed unless it is + sequence. The value of the form will not be printed unless it is wrapped in a form that does output." "expression") @@ -325,7 +338,7 @@ (defswitch "quiet" nil "Causes Lisp to start up silently, disabling printing of the herald - and causing most unnecessary noise, like GC messages,load messages, + and causing most unnecessary noise, like GC messages, load messages, etc. to be suppressed.") (defswitch "debug-lisp-search" nil @@ -338,7 +351,8 @@ (defun help-switch-demon (switch) (declare (ignore switch)) - (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) + (format t (intl:gettext "~&Usage: ~A <options> [-- [app-args]*]~2%") + *command-line-utility-name*) (flet ((get-words (s) (declare (string s)) @@ -366,7 +380,12 @@ :key #'car)) (destructuring-bind (name doc arg) s - (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) + ;; Print both -switch and --switch, and the optional arg + ;; value. + (format t " -~A|--~A ~@[~A~]~%" + name name + (if arg (intl:gettext arg))) + ;; Poor man's formatting of the help string (let ((*print-right-margin* 80)) ;; Extract all the words from the string and print them out @@ -392,19 +411,14 @@ (defswitch "help" #'help-switch-demon "Print out the command line options and exit") -(defswitch "-help" #'help-switch-demon - "Same as -help.") - (defun version-switch-demon (switch) (declare (ignore switch)) (format t "~A~%" (lisp-implementation-version)) (ext:quit)) +;; the switches "-version" and "--version" are never actually called +;; from lisp because main() handles it and returns before the lisp +;; initial function is ever run. It's here so that -help will print +;; it out so the user knows about it. (defswitch "version" #'version-switch-demon - "Prints the cmucl version and exits") - -;; Make --version work for the benefit of those who are accustomed to -;; GNU software. -(defswitch "-version" #'version-switch-demon - "Prints the cmucl version and exits; same as -version") - + "Prints the cmucl version and exits, without loading the lisp core.") ===================================== src/code/default-site-init.lisp ===================================== @@ -32,13 +32,22 @@ ;;; bin/ ;;; lib/ ;;; cmucl/ -;;; lib/ -;;; lisp*.coore -;;; man/ -;;; src/ +;;; <version>/ +;;; lib/ +;;; share/ +;;; cmucl/ +;;; <version>/ +;;; src/ +;;; tests/ +;;; man/ +;;; man1/ ;;; ;;; If your sources are located somewhere else, change this ;;; accordingly. -(setf (search-list "target:") - '("library:../src/")) +(push (pathname + (concatenate 'string + "library:../../../../share/cmucl/" + lisp::*lisp-implementation-version* + "/src/")) + (search-list "target:")) ===================================== src/code/exports.lisp ===================================== @@ -1782,6 +1782,7 @@ "STRING-TO-OCTETS" "OCTETS-TO-STRING" "*DEFAULT-EXTERNAL-FORMAT*" "STRING-ENCODE" "STRING-DECODE" + "STRING-OCTET-COUNT" "SET-SYSTEM-EXTERNAL-FORMAT" "+REPLACEMENT-CHARACTER-CODE+" "LIST-ALL-EXTERNAL-FORMATS" ===================================== src/compiler/arm/parms.lisp ===================================== @@ -343,11 +343,11 @@ :key-or-value lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. - spare-9 spare-8 spare-7 spare-6 ===================================== src/compiler/ppc/parms.lisp ===================================== @@ -295,9 +295,9 @@ :key-and-value :key-or-value + lisp::*lisp-implementation-version* ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. - sparc-9 spare-8 spare-7 spare-6 ===================================== src/compiler/sparc/parms.lisp ===================================== @@ -358,11 +358,11 @@ *fp-constant-0f0* lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. - spare-9 spare-8 spare-7 spare-6 ===================================== src/compiler/x86/parms.lisp ===================================== @@ -380,9 +380,9 @@ :key-or-value lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. - spare-9 spare-8 spare-7 spare-6 ===================================== src/general-info/release-21f.md ===================================== @@ -27,6 +27,8 @@ public domain. * The RNG has changed from an old version of xoroshiro128+ to xoroshiro128**. This means sequences of random numbers will be different from before. See ~~#276~~. + * The layout of the distribution has changed. Version numbers are + added to files and directories. For the exact layout, see !261. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -112,9 +114,12 @@ public domain. * ~~#360~~ Adding site-init file * ~~#361~~ Add herald item to mention where to report issues * ~~#362~~ Simplify "library:" search-list + * ~~#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 * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#379~~ Support GNU-style command-line option names * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-bsd-os.pot ===================================== @@ -15,10 +15,6 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/code/bsd-os.lisp -msgid "Unix system call getrusage failed: ~A." -msgstr "" - #: src/code/signal.lisp msgid "Emt instruction" msgstr "" ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1446,8 +1446,7 @@ 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.\n" "\n" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6060,7 +6060,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Evaluate the specified Lisp expression during the start up\n" -" sequence. the value of the form will not be printed unless it is\n" +" sequence. The value of the form will not be printed unless it is\n" " wrapped in a form that does output." msgstr "" @@ -6182,7 +6182,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Causes Lisp to start up silently, disabling printing of the herald\n" -" and causing most unnecessary noise, like GC messages,load messages,\n" +" and causing most unnecessary noise, like GC messages, load messages,\n" " etc. to be suppressed." msgstr "" @@ -6197,7 +6197,7 @@ msgid "Specify the unidata.bin file to be used." msgstr "" #: src/code/commandline.lisp -msgid "~&Usage: ~A <options>~2%" +msgid "~&Usage: ~A <options> [-- [app-args]*]~2%" msgstr "" #: src/code/commandline.lisp @@ -6205,15 +6205,7 @@ msgid "Print out the command line options and exit" msgstr "" #: src/code/commandline.lisp -msgid "Same as -help." -msgstr "" - -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits" -msgstr "" - -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits; same as -version" +msgid "Prints the cmucl version and exits, without loading the lisp core." msgstr "" #: src/code/env-access.lisp ===================================== src/lisp/lisp.c ===================================== @@ -42,6 +42,12 @@ #include <time.h> #endif +#include "cmucl-version.h" + +#ifndef CMUCL_VERSION +#error CMUCL_VERSION not defined! +#endif + /* SIGINT handler that invokes the monitor. */ @@ -89,10 +95,11 @@ alloc_str_list(const char *list[]) } /* Default paths for CMUCLLIB */ + +static char cmucl_version[] = CMUCL_VERSION; + static char *cmucllib_search_list[] = { - "./.", - "./../lib/cmucl/lib", - "./../lib", + "./../lib/cmucl/" CMUCL_VERSION "/lib", NULL }; @@ -335,7 +342,7 @@ search_core(const char *lib, const char *default_core) return buf; } else { if (debug_lisp_search) { - fprintf(stderr, "Found it, but we can't read it!\n"); + fprintf(stderr, "Does not exist, or can't read it if it does!\n"); } } } while (*lib++ == ':'); @@ -453,6 +460,41 @@ core_failure(const char* core, const char* argv[]) exit(1); } +/* + * Match the actual command line option "arg" with the arg name in + * "argname". The option matches if it is exacty the arg name + * prefixed by either one or two "-" characters. + * + * Returns non-zero if it matches. + */ +int match_option(const char* arg, const char* argname) +{ + if ((strlen(arg) < 2) || strlen(argname) < 1) { + /* + * The actual arg must be at least 2 characters. The argname + * must have at least 1. + */ + return 0; + } + + /* Must start with a "-" */ + if (arg[0] != '-') { + return 0; + } + + if (strcmp(arg + 1, argname) == 0) { + /* We have "-" followed by the argname. That's a match. */ + return 1; + } + + if ((arg[1] == '-') && (strcmp(arg + 2, argname) == 0)) { + /* We have "--" followed by the argname. That's a match. */ + return 1; + } + + return 0; +} + int main(int argc, const char *argv[], const char *envp[]) { @@ -522,7 +564,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-core") == 0) { + if (match_option(arg, "core")) { if (builtin_image_flag) { fprintf(stderr, "Warning: specifying a core file with an executable image is unusual,\nbut should work.\n"); @@ -536,87 +578,98 @@ main(int argc, const char *argv[], const char *envp[]) core = *++argptr; if (core == NULL) { fprintf(stderr, - "-core must be followed by the name of the core file to use.\n"); + "%s must be followed by the name of the core file to use.\n", + arg); exit(1); } - } else if (strcmp(arg, "-lib") == 0) { + } else if (match_option(arg, "lib")) { lib = *++argptr; if (lib == NULL) { fprintf(stderr, - "-lib must be followed by a string denoting the CMUCL library path.\n"); + "%s must be followed by a string denoting the CMUCL library path.\n", + arg); exit(1); } - } else if (strcmp(arg, "-read-only-space-size") == 0) { + } else if (match_option(arg, "read-only-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-read-only-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } read_only_space_size = atoi(str) * 1024 * 1024; if (read_only_space_size > READ_ONLY_SPACE_SIZE) { fprintf(stderr, - "-read-only-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, READ_ONLY_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); read_only_space_size = READ_ONLY_SPACE_SIZE; } - } else if (strcmp(arg, "-static-space-size") == 0) { + } else if (match_option(arg, "static-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-static-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } static_space_size = atoi(str) * 1024 * 1024; if (static_space_size > STATIC_SPACE_SIZE) { fprintf(stderr, - "-static-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, STATIC_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); static_space_size = STATIC_SPACE_SIZE; } - } else if (strcmp(arg, "-binding-stack-size") == 0) { + } else if (match_option(arg, "binding-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-binding-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } binding_stack_size = atoi(str) * 1024 * 1024; if (binding_stack_size > BINDING_STACK_SIZE) { fprintf(stderr, - "-binding-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, BINDING_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); binding_stack_size = BINDING_STACK_SIZE; } - } else if (strcmp(arg, "-control-stack-size") == 0) { + } else if (match_option(arg, "control-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-control-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } control_stack_size = atoi(str) * 1024 * 1024; if (control_stack_size > CONTROL_STACK_SIZE) { fprintf(stderr, - "-control-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, CONTROL_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); control_stack_size = CONTROL_STACK_SIZE; } - } else if (strcmp(arg, "-dynamic-space-size") == 0) { + } else if (match_option(arg, "dynamic-space-size")) { const char *str; str = *++argptr; if (str == NULL) { fprintf(stderr, - "-dynamic-space-size must be followed by the size to use in MBytes.\n"); + "%s must be followed by the size to use in MBytes.\n", + arg); exit(1); } #ifndef sparc @@ -662,17 +715,26 @@ main(int argc, const char *argv[], const char *envp[]) #endif if (dynamic_space_size > DYNAMIC_SPACE_SIZE) { fprintf(stderr, - "-dynamic-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, DYNAMIC_SPACE_SIZE / (1024 * 1024UL)); exit(1); } - } else if (strcmp(arg, "-monitor") == 0) { + } else if (match_option(arg, "monitor")) { monitor = TRUE; - } else if (strcmp(arg, "-debug-lisp-search") == 0) { + } else if (match_option(arg, "debug-lisp-search")) { debug_lisp_search = TRUE; - } else if (strcmp(arg, "-unidata") == 0) { + } else if (match_option(arg, "unidata")) { unidata = *++argptr; - } + } else if ((strcmp(arg, "-version") == 0) || + (strcmp(arg, "--version") == 0)) { + /* + * Print the version and exit; we don't want to do + * anything else! + */ + printf("%s\n", cmucl_version); + return 0; + } } default_core = arch_init(fpu_mode); @@ -889,7 +951,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-batch") == 0) + if (match_option(arg, "batch")) SetSymbolValue(BATCH_MODE, T); } @@ -899,6 +961,10 @@ main(int argc, const char *argv[], const char *envp[]) } #endif +#ifdef LISP_IMPLEMENTATION_VERSION + SetSymbolValue(LISP_IMPLEMENTATION_VERSION, alloc_string(cmucl_version)); +#endif + /* * Pick off sigint until the lisp system gets far enough along to * install it's own. ===================================== src/tools/worldload.lisp ===================================== @@ -31,12 +31,6 @@ ;(setf lisp::*enable-dynamic-space-code* t) -;;; Get some data on this core. -;;; -(write-string "What is the current lisp-implementation-version? ") -(force-output) -(set '*lisp-implementation-version* (read-line)) - ;;; Load the rest of the reader (maybe byte-compiled.) (maybe-byte-load "target:code/sharpm") (maybe-byte-load "target:code/backq") ===================================== tests/unix.lisp ===================================== @@ -50,28 +50,6 @@ (assert-false fd) (assert-true (and (integerp errno) (plusp errno))))) -;; Darwin accepts this template. It creates the file "test-". -#-darwin -(define-test mkstemp.bad-template - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-") - ;; The template doesn't have enough X's 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))))) - -;; Darwin accepts this template and just creates the file -;; "test-XXXXXXa". (The next call would return an error.) -#-darwin -(define-test mkstemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-XXXXXXa") - ;; The template doesn't end in X's - (assert-false fd) - (assert-true (and (integerp errno) (plusp errno))))) - (define-test mkdtemp.name-returned (:tag :issues) (let (name) @@ -110,22 +88,4 @@ (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) -;; Darwin allows any number of X's. -#-darwin -(define-test mkdtemp.bad-template - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-") - ;; No X's in template, like for mkstemp.bad-template test. - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) -;; Same issue with mkdtemp as with mkstemp above on Darwin. -#-darwin -(define-test mkdtemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-XXXXXXa") - ;; Template doesn't end in X's - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/70b34d286372eb642292d1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/70b34d286372eb642292d1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-375-mkstemp-return-filename] 3 commits: Rename mkstemp.name-returned.2 to mkstemp.non-ascii-name-returned
by Raymond Toy (＠rtoy) 17 Feb '25

17 Feb '25

Raymond Toy pushed to branch issue-375-mkstemp-return-filename at cmucl / cmucl Commits: 30c30e87 by Raymond Toy at 2025-02-16T18:48:47-08:00 Rename mkstemp.name-returned.2 to mkstemp.non-ascii-name-returned Test name better reflects that we're testing a template with non-ascii characters. - - - - - 4827d17e by Raymond Toy at 2025-02-16T18:48:47-08:00 Rename mkdtemp.name-returned.2 to mkdtemp.non-ascii-name-returned Test name better reflects that we're testing a template with non-ascii characters. - - - - - 70b34d28 by Raymond Toy at 2025-02-16T18:48:47-08:00 Usee system-area-copy to copy the octets to the buffer Better than using our own loop. Also forgot to set the last byte of the buffer to 0 (to terminate the C string) in unix-mkdtemp, so do it now. - - - - - 2 changed files: - src/code/unix.lisp - tests/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2921,8 +2921,10 @@ (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. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (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)) @@ -2955,8 +2957,12 @@ (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. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + (let ((result (alien-funcall (extern-alien "mkdtemp" (function (* char) ===================================== tests/unix.lisp ===================================== @@ -20,7 +20,7 @@ (when fd (unix:unix-unlink name))))) -(define-test mkstemp.name-returned.2 +(define-test mkstemp.non-ascii-name-returned (:tag :issues) (let ((unix::*filename-encoding* :utf-8) fd name) @@ -84,7 +84,7 @@ (when name (unix:unix-rmdir name))))) -(define-test mkdtemp.name-returned.2 +(define-test mkdtemp.non-ascii-name-returned (:tag :issues) (let ((unix::*filename-encoding* :utf-8) name) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b65c787bfdbd4ee9d2a8fd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b65c787bfdbd4ee9d2a8fd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-375-mkstemp-return-filename] Apply suggestion to mkstemp.name-returned
by Raymond Toy (＠rtoy) 17 Feb '25

17 Feb '25

Raymond Toy pushed to branch issue-375-mkstemp-return-filename at cmucl / cmucl Commits: b65c787b by Raymond Toy at 2025-02-17T02:09:01+00:00 Apply suggestion to mkstemp.name-returned Compare returned name with template (which should be different). Add a few more tests for some other invariants. - - - - - 1 changed file: - tests/unix.lisp Changes: ===================================== tests/unix.lisp ===================================== @@ -7,13 +7,16 @@ (define-test mkstemp.name-returned (:tag :issues) - (let (fd name) + (let (fd filename) (unwind-protect (progn - (multiple-value-setq (fd name) - (unix::unix-mkstemp "test-XXXXXX")) - (assert-true fd) - (assert-false (search "XXXXXX" name))) + (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 name))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b65c787bfdbd4ee9d2a8fd4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b65c787bfdbd4ee9d2a8fd4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #382: Make command-line options be case-sensitive instead of case-insenstive
by Raymond Toy (＠rtoy) 17 Feb '25

17 Feb '25

Raymond Toy pushed to branch master 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 - - - - - 1 changed file: - src/code/commandline.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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/38da65c4f6d43c2e0eb211… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/38da65c4f6d43c2e0eb211… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-381-cmucl-unix-os-specific
by Raymond Toy (＠rtoy) 16 Feb '25

16 Feb '25

Raymond Toy pushed new branch issue-381-cmucl-unix-os-specific at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-381-cmucl-unix-os-s… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0