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

[Git][cmucl/cmucl][issue-139-add-alias-local-external-format] 7 commits: Fix #130: Implement file_author in C
by Raymond Toy (＠rtoy) 31 Oct '22

31 Oct '22

Raymond Toy pushed to branch issue-139-add-alias-local-external-format at cmucl / cmucl Commits: 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - e8a0cc6c by Raymond Toy at 2022-10-30T15:03:27+00:00 Fix #147: Add method for stream-line-column - - - - - 0dad5a1a by Raymond Toy at 2022-10-30T15:03:28+00:00 Merge branch 'issue-147-stream-line-column-impl' into 'master' Fix #147: Add method for stream-line-column Closes #147 See merge request cmucl/cmucl!104 - - - - - 1300830b by Raymond Toy at 2022-10-31T17:12:48+00:00 Address #139: *default-external-format* is :utf-8 - - - - - 649a4f1e by Raymond Toy at 2022-10-31T17:12:49+00:00 Merge branch 'issue-139-default-external-format-utf8' into 'master' Address #139: *default-external-format* is :utf-8 See merge request cmucl/cmucl!103 - - - - - 69f2a990 by Raymond Toy at 2022-10-31T10:14:48-07:00 Merge branch 'master' into issue-139-add-alias-local-external-format - - - - - 9 changed files: - src/code/extfmts.lisp - src/code/filesys.lisp - src/general-info/release-21e.md - src/lisp/os-common.c - src/pcl/gray-streams.lisp - + tests/.gitignore - tests/issues.lisp - + tests/utf8.txt - + tests/안녕하십니까.txt Changes: ===================================== src/code/extfmts.lisp ===================================== @@ -22,7 +22,7 @@ describe-external-format)) (defvar *default-external-format* - :iso8859-1 + :utf-8 "The default external format to use if no other external format is specified") ===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/general-info/release-21e.md ===================================== @@ -22,6 +22,7 @@ public domain. * Feature enhancements * Changes * Update to ASDF 3.3.6 + * The default external format is `:utf-8` instead of `:iso8859-1` * ANSI compliance fixes: * Bug fixes: * ~~#97~~ Fixes stepping through the source forms in the debugger. This has been broken for quite some time, but it works now. @@ -56,6 +57,7 @@ public domain. * ~~#132~~ Ansi test `RENAME-FILE.1` no fails * ~~#134~~ Handle the case of `(expt complex complex-rational)` * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * #139 `*default-external-format*` defaults to `:utf-8` * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== src/pcl/gray-streams.lisp ===================================== @@ -235,6 +235,9 @@ defined for this function, although it is permissible for it to always return NIL.")) +(defmethod stream-line-column ((stream fundamental-character-output-stream)) + nil) + ;;; Stream-line-length is a CMUCL extension to Gray streams. (defgeneric stream-line-length (stream) (:documentation _N"Return the stream line length or Nil.")) ===================================== tests/.gitignore ===================================== @@ -0,0 +1 @@ +/out-utf8.txt ===================================== tests/issues.lisp ===================================== @@ -5,6 +5,12 @@ (in-package "ISSUES-TESTS") +(defparameter *test-path* + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) + *load-truename*) + "Path to where this file is.") + (defun square (x) (expt x 2)) @@ -670,3 +676,72 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (let ((unix::*filename-encoding* :utf-8)) + ;; Set filename encoding to utf-8 so that we can encode the + ;; filename properly. + (assert-true + (file-author + (merge-pathnames + (concatenate 'string + ;; Write the test file name this way so + ;; that it's independent of the encoding + ;; used to load this file. The name is + ;; "안녕하십니까". + '(#\Hangul_Syllable_An #\Hangul_Syllable_Nyeong #\Hangul_Syllable_Ha + #\Hangul_Syllable_Sib #\Hangul_Syllable_Ni #\Hangul_Syllable_Gga) + ".txt") + *test-path*))))) + +(define-test issue.139-default-external-format + (:tag :issues) + (assert-eq :utf-8 stream:*default-external-format*)) + +(define-test issue.139-default-external-format-read-file + (:tag :issues) + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + ;; Test that opening a file for reading uses the the default :utf8 + ;; encoding. + (with-open-file (s (merge-pathnames "utf8.txt" + *test-path*) + :direction :input) + ;; The first line should be "hello" in Hangul. + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + +(define-test issue.139-default-external-format-write-file + (:tag :issues) + ;; Test that opening a file for writing uses the default :utf8. + ;; First write something out to the file. Then read it back in + ;; using an explicit format of utf8 and verifying that we got the + ;; right contents. + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :output + :if-exists :supersede) + (write-line string s)) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :input + :external-format :utf-8) + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + ===================================== tests/utf8.txt ===================================== @@ -0,0 +1,2 @@ +안녕하세요 +UTF8 test. The above line is "Hello" in Hangul. ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b627c1e36a02140adc6264… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b627c1e36a02140adc6264… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Address #139: *default-external-format* is :utf-8
by Raymond Toy (＠rtoy) 31 Oct '22

31 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1300830b by Raymond Toy at 2022-10-31T17:12:48+00:00 Address #139: *default-external-format* is :utf-8 - - - - - 649a4f1e by Raymond Toy at 2022-10-31T17:12:49+00:00 Merge branch 'issue-139-default-external-format-utf8' into 'master' Address #139: *default-external-format* is :utf-8 See merge request cmucl/cmucl!103 - - - - - 5 changed files: - src/code/extfmts.lisp - src/general-info/release-21e.md - + tests/.gitignore - tests/issues.lisp - + tests/utf8.txt Changes: ===================================== src/code/extfmts.lisp ===================================== @@ -22,7 +22,7 @@ describe-external-format)) (defvar *default-external-format* - :iso8859-1 + :utf-8 "The default external format to use if no other external format is specified") ===================================== src/general-info/release-21e.md ===================================== @@ -22,6 +22,7 @@ public domain. * Feature enhancements * Changes * Update to ASDF 3.3.6 + * The default external format is `:utf-8` instead of `:iso8859-1` * ANSI compliance fixes: * Bug fixes: * ~~#97~~ Fixes stepping through the source forms in the debugger. This has been broken for quite some time, but it works now. @@ -56,6 +57,7 @@ public domain. * ~~#132~~ Ansi test `RENAME-FILE.1` no fails * ~~#134~~ Handle the case of `(expt complex complex-rational)` * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * #139 `*default-external-format*` defaults to `:utf-8` * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== tests/.gitignore ===================================== @@ -0,0 +1 @@ +/out-utf8.txt ===================================== tests/issues.lisp ===================================== @@ -5,6 +5,12 @@ (in-package "ISSUES-TESTS") +(defparameter *test-path* + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) + *load-truename*) + "Path to where this file is.") + (defun square (x) (expt x 2)) @@ -676,4 +682,66 @@ ;; work and not return NIL. (assert-true (file-author ".")) (assert-true (file-author "bin/build.sh")) - (assert-true (file-author "tests/안녕하십니까.txt"))) + (let ((unix::*filename-encoding* :utf-8)) + ;; Set filename encoding to utf-8 so that we can encode the + ;; filename properly. + (assert-true + (file-author + (merge-pathnames + (concatenate 'string + ;; Write the test file name this way so + ;; that it's independent of the encoding + ;; used to load this file. The name is + ;; "안녕하십니까". + '(#\Hangul_Syllable_An #\Hangul_Syllable_Nyeong #\Hangul_Syllable_Ha + #\Hangul_Syllable_Sib #\Hangul_Syllable_Ni #\Hangul_Syllable_Gga) + ".txt") + *test-path*))))) + +(define-test issue.139-default-external-format + (:tag :issues) + (assert-eq :utf-8 stream:*default-external-format*)) + +(define-test issue.139-default-external-format-read-file + (:tag :issues) + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + ;; Test that opening a file for reading uses the the default :utf8 + ;; encoding. + (with-open-file (s (merge-pathnames "utf8.txt" + *test-path*) + :direction :input) + ;; The first line should be "hello" in Hangul. + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + +(define-test issue.139-default-external-format-write-file + (:tag :issues) + ;; Test that opening a file for writing uses the default :utf8. + ;; First write something out to the file. Then read it back in + ;; using an explicit format of utf8 and verifying that we got the + ;; right contents. + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :output + :if-exists :supersede) + (write-line string s)) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :input + :external-format :utf-8) + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + ===================================== tests/utf8.txt ===================================== @@ -0,0 +1,2 @@ +안녕하세요 +UTF8 test. The above line is "Hello" in Hangul. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/0dad5a1a767748e6c4fafb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/0dad5a1a767748e6c4fafb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-139-default-external-format-utf8] Adjust issue.130 test encoding
by Raymond Toy (＠rtoy) 31 Oct '22

31 Oct '22

Raymond Toy pushed to branch issue-139-default-external-format-utf8 at cmucl / cmucl Commits: 2fed09ce by Raymond Toy at 2022-10-30T17:41:37-07:00 Adjust issue.130 test encoding * Create the test file name using the character names so that the name is independent of the encoding used to read/compile the file. * Set `unix::*filename-encoding*` to `:utf-8` so that we can encode the file name properly before handing to `file-author` Not sure why this was working in merge !88, but it's not working locally and not working in CI. With this change, it's working locally now. - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== @@ -682,7 +682,21 @@ ;; work and not return NIL. (assert-true (file-author ".")) (assert-true (file-author "bin/build.sh")) - (assert-true (file-author "tests/안녕하십니까.txt"))) + (let ((unix::*filename-encoding* :utf-8)) + ;; Set filename encoding to utf-8 so that we can encode the + ;; filename properly. + (assert-true + (file-author + (merge-pathnames + (concatenate 'string + ;; Write the test file name this way so + ;; that it's independent of the encoding + ;; used to load this file. The name is + ;; "안녕하십니까". + '(#\Hangul_Syllable_An #\Hangul_Syllable_Nyeong #\Hangul_Syllable_Ha + #\Hangul_Syllable_Sib #\Hangul_Syllable_Ni #\Hangul_Syllable_Gga) + ".txt") + *test-path*))))) (define-test issue.139-default-external-format (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2fed09ce4c3f8c60b077ffe… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2fed09ce4c3f8c60b077ffe… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-139-default-external-format-utf8] 3 commits: Fix #130: Implement file_author in C
by Raymond Toy (＠rtoy) 30 Oct '22

30 Oct '22

Raymond Toy pushed to branch issue-139-default-external-format-utf8 at cmucl / cmucl Commits: 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - ab9b27f9 by Raymond Toy at 2022-10-30T12:42:13-07:00 Merge branch 'master' into issue-139-default-external-format-utf8 - - - - - 4 changed files: - src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== tests/issues.lisp ===================================== @@ -676,6 +676,14 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) + (define-test issue.139-default-external-format (:tag :issues) (assert-eq :utf-8 stream:*default-external-format*)) ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3717f16569510d166630f0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3717f16569510d166630f0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] 16 commits: Fix #132: Ansi test RENAME-FILE.1 fails
by Raymond Toy (＠rtoy) 30 Oct '22

30 Oct '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: cdd7d328 by Raymond Toy at 2022-10-15T14:39:32+00:00 Fix #132: Ansi test RENAME-FILE.1 fails - - - - - e0e9f62d by Raymond Toy at 2022-10-15T14:39:35+00:00 Merge branch 'issue-132-ansi-test-rename-files' into 'master' Fix #132: Ansi test RENAME-FILE.1 fails Closes #132 See merge request cmucl/cmucl!90 - - - - - a05277c7 by Raymond Toy at 2022-10-15T20:53:20+00:00 Fix #134: Handle the case of (expt complex complex-rational) - - - - - 4dacd5ac by Raymond Toy at 2022-10-15T20:53:20+00:00 Merge branch 'issue-134-expt-bug' into 'master' Fix #134: Handle the case of (expt complex complex-rational) Closes #134 See merge request cmucl/cmucl!91 - - - - - 8719b21c by Raymond Toy at 2022-10-15T23:27:33+00:00 Fix #146: CI passes incorrectly - - - - - 9c0f63ff by Raymond Toy at 2022-10-15T23:27:34+00:00 Merge branch 'issue-146-ci-passes-incorrectly' into 'master' Fix #146: CI passes incorrectly Closes #146 See merge request cmucl/cmucl!100 - - - - - cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - 6e975c79 by Raymond Toy at 2022-10-30T11:55:47-07:00 Merge branch 'master' into issue-141-locale - - - - - 5 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== tests/issues.lisp ===================================== @@ -670,3 +670,10 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/82ac3a68ea524768d60096… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/82ac3a68ea524768d60096… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-139-default-external-format-utf8] Add test file and git ignore output file
by Raymond Toy (＠rtoy) 30 Oct '22

30 Oct '22

Raymond Toy pushed to branch issue-139-default-external-format-utf8 at cmucl / cmucl Commits: 3717f165 by Raymond Toy at 2022-10-30T09:33:54-07:00 Add test file and git ignore output file Forgot to add the test file used for testing opening files with the default external format. Ignore the output file. - - - - - 2 changed files: - + tests/.gitignore - + tests/utf8.txt Changes: ===================================== tests/.gitignore ===================================== @@ -0,0 +1 @@ +/out-utf8.txt ===================================== tests/utf8.txt ===================================== @@ -0,0 +1,2 @@ +안녕하세요 +UTF8 test. The above line is "Hello" in Hangul. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3717f16569510d166630f00… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3717f16569510d166630f00… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-139-default-external-format-utf8] Update release notes and add tests
by Raymond Toy (＠rtoy) 30 Oct '22

30 Oct '22

Raymond Toy pushed to branch issue-139-default-external-format-utf8 at cmucl / cmucl Commits: a130c526 by Raymond Toy at 2022-10-30T09:14:18-07:00 Update release notes and add tests Update the release notes to say `*default-external-format*` is now `:utf-8`. Add tests for the default external format by opening files for reading and writing and verifying that we get the right things with the default format of :utf8. Manually verified that these tests fail with version snapshot-2021-07. - - - - - 2 changed files: - src/general-info/release-21e.md - tests/issues.lisp Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -22,6 +22,7 @@ public domain. * Feature enhancements * Changes * Update to ASDF 3.3.6 + * The default external format is `:utf-8` instead of `:iso8859-1` * ANSI compliance fixes: * Bug fixes: * ~~#97~~ Fixes stepping through the source forms in the debugger. This has been broken for quite some time, but it works now. @@ -56,6 +57,7 @@ public domain. * ~~#132~~ Ansi test `RENAME-FILE.1` no fails * ~~#134~~ Handle the case of `(expt complex complex-rational)` * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * #139 `*default-external-format*` defaults to `:utf-8` * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== tests/issues.lisp ===================================== @@ -5,6 +5,12 @@ (in-package "ISSUES-TESTS") +(defparameter *test-path* + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) + *load-truename*) + "Path to where this file is.") + (defun square (x) (expt x 2)) @@ -670,3 +676,50 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.139-default-external-format + (:tag :issues) + (assert-eq :utf-8 stream:*default-external-format*)) + +(define-test issue.139-default-external-format-read-file + (:tag :issues) + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + ;; Test that opening a file for reading uses the the default :utf8 + ;; encoding. + (with-open-file (s (merge-pathnames "utf8.txt" + *test-path*) + :direction :input) + ;; The first line should be "hello" in Hangul. + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + +(define-test issue.139-default-external-format-write-file + (:tag :issues) + ;; Test that opening a file for writing uses the default :utf8. + ;; First write something out to the file. Then read it back in + ;; using an explicit format of utf8 and verifying that we got the + ;; right contents. + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :output + :if-exists :supersede) + (write-line string s)) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :input + :external-format :utf-8) + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a130c52629119ed282263fc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a130c52629119ed282263fc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #147: Add method for stream-line-column
by Raymond Toy (＠rtoy) 30 Oct '22

30 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e8a0cc6c by Raymond Toy at 2022-10-30T15:03:27+00:00 Fix #147: Add method for stream-line-column - - - - - 0dad5a1a by Raymond Toy at 2022-10-30T15:03:28+00:00 Merge branch 'issue-147-stream-line-column-impl' into 'master' Fix #147: Add method for stream-line-column Closes #147 See merge request cmucl/cmucl!104 - - - - - 1 changed file: - src/pcl/gray-streams.lisp Changes: ===================================== src/pcl/gray-streams.lisp ===================================== @@ -235,6 +235,9 @@ defined for this function, although it is permissible for it to always return NIL.")) +(defmethod stream-line-column ((stream fundamental-character-output-stream)) + nil) + ;;; Stream-line-length is a CMUCL extension to Gray streams. (defgeneric stream-line-length (stream) (:documentation _N"Return the stream line length or Nil.")) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba5c5d2a6813c3c1504d9f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba5c5d2a6813c3c1504d9f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-135-unix-namestring-dot] Remove special case from file-author
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed to branch issue-135-unix-namestring-dot at cmucl / cmucl Commits: ef2a1fc3 by Raymond Toy at 2022-10-19T13:44:15-07:00 Remove special case from file-author file-author had a special case when `(unix-namestring ".")` returned "". This doesn't happen anymore, so remove the special case. `(file-author ".")` returns the expected author. - - - - - 1 changed file: - src/code/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1079,11 +1079,6 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - ;; unix-namestring converts "." to "". Convert it back to - ;; "." so we can stat the current directory. (Perhaps - ;; that's a bug in unix-namestring?) - (when (zerop (length name)) - (setf name ".")) (let (author) (unwind-protect (progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef2a1fc306f966f78c8663b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef2a1fc306f966f78c8663b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-135-unix-namestring-dot] Remove debugging print
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed to branch issue-135-unix-namestring-dot at cmucl / cmucl Commits: 9c006ed9 by Raymond Toy at 2022-10-19T13:00:07-07:00 Remove debugging print - - - - - 1 changed file: - src/code/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -883,7 +883,6 @@ (when (or (not executable-only) (and (eq (unix:unix-file-kind name) :file) (unix:unix-access name unix:x_ok))) - (format t "unix-namestring: name = ~A~%" name) (names name))) (let ((names (names))) (when names View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9c006ed9c316b444ab95970… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9c006ed9c316b444ab95970… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-135-unix-namestring-dot] 7 commits: Fix #146: CI passes incorrectly
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed to branch issue-135-unix-namestring-dot at cmucl / cmucl Commits: 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - e637721a by Raymond Toy at 2022-10-19T07:28:32-07:00 Merge branch 'master' into issue-135-unix-namestring-dot - - - - - adaadb3f by Raymond Toy at 2022-10-19T10:44:43-07:00 Remove debugging print - - - - - 291b8619 by Raymond Toy at 2022-10-19T10:45:05-07:00 Fix up tests to run correctly - - - - - 3f663e8f by Raymond Toy at 2022-10-19T10:52:02-07:00 Simplify test for unix-namestring `unix-namestring` requires files to exist to be able to return a non-NIL result. We assume the tests are run from the top of the source tree, so we can reference things in the source tree. - - - - - 5 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -786,7 +786,6 @@ (let ((name (%pathname-name pathname)) (type (%pathname-type pathname)) (version (%pathname-version pathname))) - (format t "name type version = ~S ~S ~S~%" name type version) (cond ((member name '(nil :unspecific)) (when (or (not verify-existence) (unix:unix-file-kind directory)) @@ -1081,13 +1080,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== tests/issues.lisp ===================================== @@ -670,8 +670,37 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) + (define-test issue.135 (:tag :issues) - (assert-equalp "." (ext:unix-namestring ".")) - (assert-equalp "./abc.txt" (ext:unix-namestring "abc.txt")) - (assert-equalp "./abc/def/foo.txt" (ext:unix-namestring "abc/def/foo.txt"))) + (assert-equalp "./" (ext:unix-namestring ".")) + (unwind-protect + (progn + ;; Create a test file in the current directory. + ;; unix-namestring requires files to exist to be able to + ;; return the namestring. + (with-open-file (f1 "foo.txt" + :direction :output + :if-exists :supersede) + (print "foo" f1)) + ;; Check unix-namestring and verify that converting the + ;; namestring to a pathname results in the same pathname + ;; object as expected. + (let ((foo (ext:unix-namestring "foo.txt"))) + (assert-equalp "foo.txt" foo) + (assert-equalp (make-pathname :name "foo" :type "txt") + (pathname foo))) + (let ((bar (ext:unix-namestring "src/code/filesys.lisp"))) + (assert-equalp "./src/code/filesys.lisp" bar) + (assert-equalp (make-pathname :directory '(:relative "src" "code") + :name "filesys" + :type "lisp") + (pathname bar)))) + (assert-true (delete-file "foo.txt")))) ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/24cc68e54ee74ed8c74150… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/24cc68e54ee74ed8c74150… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-147-stream-line-column-impl
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed new branch issue-147-stream-line-column-impl at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-147-stream-line-col… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 3 commits: Fix #130: Implement file_author in C
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - 5944241c by Raymond Toy at 2022-10-18T17:13:26-07:00 Merge branch 'master' into issue-140-stream-element-type-two-way-stream - - - - - 4 changed files: - src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== tests/issues.lisp ===================================== @@ -670,6 +670,14 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) + ;;; Test stream-external-format for various types of streams. ;; Test two-way-stream where both streams have the same external ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/145aa085a805aa7f20ea45… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/145aa085a805aa7f20ea45… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] Allow broadcast-stream and two-way-stream for stream-external-format
by Raymond Toy (＠rtoy) 19 Oct '22

19 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: 145aa085 by Raymond Toy at 2022-10-18T17:06:58-07:00 Allow broadcast-stream and two-way-stream for stream-external-format `stream-external-format` for a `broadcast-stream` is `:default`, according to the CLHS. For a `two-way-stream`, the CLHS doesn't say, so we'll return the common external format if there is one, or `:default` if they're different. For a `synonym-stream`, the CLHS also doesn't say, so we'll just return the format of the value of the synonym stream symbol. Add tests for test different types of streams, except for `broadcast-stream`. The ansi-tests have tests for this. - - - - - 2 changed files: - src/code/stream.lisp - tests/issues.lisp Changes: ===================================== src/code/stream.lisp ===================================== @@ -295,8 +295,22 @@ (etypecase stream #+unicode (fd-stream (fd-stream-external-format stream)) - (synonym-stream (stream-external-format - (symbol-value (synonym-stream-symbol stream))))) + (broadcast-stream + ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm + :default) + (synonym-stream + ;; What should happen if (synonym-stream-symbol stream) is unbound? + (stream-external-format + (symbol-value (synonym-stream-symbol stream)))) + (two-way-stream + ;; Not defined by CLHS, but useful to return the common format + ;; of the input and output streams when they're the same; + ;; otherwise return :default. + (let ((in-format (stream-external-format (two-way-stream-input-stream stream))) + (out-format (stream-external-format (two-way-stream-output-stream stream)))) + (if (eql in-format out-format) + in-format + :default)))) ;; fundamental-stream :default)) ===================================== tests/issues.lisp ===================================== @@ -670,9 +670,42 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) -(define-test issue.140 +;;; Test stream-external-format for various types of streams. + +;; Test two-way-stream where both streams have the same external +;; format. +(define-test issue.140.1 + (:tag :issues) + (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) + :direction :input + :external-format :utf-8) + (with-open-file (out "/tmp/output.tst" + :direction :output + :external-format :utf-8 + :if-exists :supersede) + (let ((two-way-stream (make-two-way-stream in out))) + (assert-equal :utf-8 (stream-external-format two-way-stream)))))) + +;; Test two-way-stream where the two streams have the different +;; external formats. +(define-test issue.140.2 (:tag :issues) - (with-output-to-string (out) - (with-input-from-string (in "abc") + (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) + :direction :input + :external-format :iso8859-1) + (with-open-file (out "/tmp/output.tst" + :direction :output + :external-format :utf-8 + :if-exists :supersede) (let ((two-way-stream (make-two-way-stream in out))) - (assert-error 'type-error (stream-external-format two-way-stream)))))) + (assert-equal :default (stream-external-format two-way-stream)))))) + +;; Test synonym-stream returns the format of the underlying stream. +(define-test issue.140.3 + (:tag :issues) + (with-open-file (s (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) + :direction :input + :external-format :iso8859-1) + (let ((syn (make-synonym-stream '*syn-stream*))) + (setf syn s) + (assert-equal :iso8859-1 (stream-external-format syn))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/145aa085a805aa7f20ea455… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/145aa085a805aa7f20ea455… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-139-default-external-format-utf8
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed new branch issue-139-default-external-format-utf8 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-139-default-externa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-139-terminal-format-is-locale
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed new branch issue-139-terminal-format-is-locale at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-139-terminal-format… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #130: Implement file_author in C
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C - - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master' Fix #130: Implement file_author in C Closes #130 See merge request cmucl/cmucl!88 - - - - - 4 changed files: - src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author)))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@ */ +#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + struct stat sb; + char initial[1024]; + char *buffer, *obuffer; + size_t size; + struct passwd pwd; + struct passwd *ppwd; + char *result; + + if (stat(path, &sb) != 0) { + return NULL; + } + + result = NULL; + buffer = initial; + obuffer = NULL; + size = sizeof(initial) / sizeof(initial[0]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +} ===================================== tests/issues.lisp ===================================== @@ -670,3 +670,10 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95b4fc5c7629530925acfa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95b4fc5c7629530925acfa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-139-add-alias-local-external-format
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed new branch issue-139-add-alias-local-external-format at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-139-add-alias-local… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] Revert previous change and use Carl's suggestion.
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: 10874b35 by Raymond Toy at 2022-10-17T11:34:00-07:00 Revert previous change and use Carl's suggestion. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -730,7 +730,7 @@ os_file_author(const char *path) { struct stat sb; char initial[1024]; - char *buffer, *newbuffer; + char *buffer, *obuffer; size_t size; struct passwd pwd; struct passwd *ppwd; @@ -742,6 +742,7 @@ os_file_author(const char *path) result = NULL; buffer = initial; + obuffer = NULL; size = sizeof(initial) / sizeof(initial[0]); /* @@ -757,11 +758,10 @@ os_file_author(const char *path) case ERANGE: /* Buffer is too small, double its size and try again */ size *= 2; - if ((newbuffer = realloc((buffer == initial) ? NULL : buffer, - size)) == NULL) { + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { goto exit; } - buffer = newbuffer; continue; default: /* All other errors */ @@ -769,9 +769,7 @@ os_file_author(const char *path) } } exit: - if (buffer != initial) { - free(buffer); - } + free(obuffer); return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/10874b356c10e8eca0f5e43… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/10874b356c10e8eca0f5e43… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] 10 commits: Fix #142: (random 0) signals incorrect error
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - 66cb86f6 by Raymond Toy at 2022-10-17T10:53:42-07:00 Merge branch 'master' into issue-130-file-author-in-c - - - - - e3f73659 by Raymond Toy at 2022-10-17T11:07:05-07:00 Address review comments Remove the assert and change the loop limit from 16384 to 1<<20. - - - - - 9e208e62 by Raymond Toy at 2022-10-17T11:26:32-07:00 Change so we only free in one place. - - - - - 6 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - src/lisp/os-common.c - tests/filesys.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -1486,4 +1486,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,8 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/lisp/os-common.c ===================================== @@ -730,7 +730,7 @@ os_file_author(const char *path) { struct stat sb; char initial[1024]; - char *buffer, *obuffer; + char *buffer, *newbuffer; size_t size; struct passwd pwd; struct passwd *ppwd; @@ -745,15 +745,10 @@ os_file_author(const char *path) size = sizeof(initial) / sizeof(initial[0]); /* - * Assume a buffer of size 16384 is enough to for getpwuid_r to do - * it's thing. + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. */ - assert(sysconf(_SC_GETPW_R_SIZE_MAX) <= 16384); - - /* - * Keep trying with larger buffers until a maximum is reached. - */ - while (size <= 16384) { + while (size <= (1 << 20)) { switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { case 0: /* Success, though we might not have a matching entry */ @@ -762,11 +757,11 @@ os_file_author(const char *path) case ERANGE: /* Buffer is too small, double its size and try again */ size *= 2; - obuffer = (buffer == initial) ? NULL : buffer; - if ((buffer = realloc(obuffer, size)) == NULL) { - free(obuffer); + if ((newbuffer = realloc((buffer == initial) ? NULL : buffer, + size)) == NULL) { goto exit; } + buffer = newbuffer; continue; default: /* All other errors */ ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3d81bc22fae31018c2fd97… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3d81bc22fae31018c2fd97… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] Forgot to update release notes for this fix.
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: 7d17444a by Raymond Toy at 2022-10-17T09:49:42-07:00 Forgot to update release notes for this fix. - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -56,7 +56,7 @@ public domain. * ~~#132~~ Ansi test `RENAME-FILE.1` no fails * ~~#134~~ Handle the case of `(expt complex complex-rational)` * ~~#136~~ `ensure-directories-exist` should return the given pathspec - * ~~#140~~ External format of `two-way-stream` returns the common format of the input and output streams if possible; otherwise, return `:default`. + * ~~#140~~ External format of `two-way-stream` * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d17444a4249f6430737792… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d17444a4249f6430737792… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] Throw error if the stream is not a file stream.
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: 08f76fc3 by Raymond Toy at 2022-10-17T09:46:45-07:00 Throw error if the stream is not a file stream. Update test to verify that a type error is thrown. - - - - - 2 changed files: - src/code/stream.lisp - tests/issues.lisp Changes: ===================================== src/code/stream.lisp ===================================== @@ -291,23 +291,12 @@ ;; simple-stream (stream::%stream-external-format stream) ;; lisp-stream - (typecase stream + ;; The stream is a file stream; signal an error if it's not. + (etypecase stream #+unicode (fd-stream (fd-stream-external-format stream)) (synonym-stream (stream-external-format - (symbol-value (synonym-stream-symbol stream)))) - (two-way-stream - (let ((input-format - (stream-external-format (two-way-stream-input-stream stream))) - (output-format - (stream-external-format (two-way-stream-output-stream stream)))) - ;; If the input and output streams have the same format, we - ;; can return the format. If they differ, it's not clear - ;; what to do, so just return :default. - (if (eql input-format output-format) - input-format - :default))) - (t :default)) + (symbol-value (synonym-stream-symbol stream))))) ;; fundamental-stream :default)) ===================================== tests/issues.lisp ===================================== @@ -672,12 +672,7 @@ (define-test issue.140 (:tag :issues) - ;; Make sure *standard-input* is a two-way-stream - (assert-true (typep *standard-input* 'two-way-stream)) - (let ((input-format (stream-external-format - (two-way-stream-input-stream *standard-input*))) - (output-format (stream-external-format - (two-way-stream-output-stream *standard-input*)))) - ;; By default, the input and output formats should be the same. - (assert-eql input-format output-format) - (assert-eql input-format (stream-external-format *standard-input*)))) + (with-output-to-string (out) + (with-input-from-string (in "abc") + (let ((two-way-stream (make-two-way-stream in out))) + (assert-error 'type-error (stream-external-format two-way-stream)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 8 commits: Fix #142: (random 0) signals incorrect error
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - cb749b6d by Raymond Toy at 2022-10-17T08:52:54-07:00 Merge branch 'master' into issue-140-stream-element-type-two-way-stream - - - - - 5 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - tests/filesys.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -1478,4 +1478,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,9 +50,14 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec * ~~#140~~ External format of `two-way-stream` returns the common format of the input and output streams if possible; otherwise, return `:default`. + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/480f9c604bb6a4c4e18895… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/480f9c604bb6a4c4e18895… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Fix #146: CI passes incorrectly
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95b4fc5c7629530925acfa8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95b4fc5c7629530925acfa8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] 7 commits: Fix #132: Ansi test RENAME-FILE.1 fails
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: a5767df5 by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #132: Ansi test RENAME-FILE.1 fails - - - - - 6a9c3afb by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #134: Handle the case of (expt complex complex-rational) - - - - - 119ec29f by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #146: CI passes incorrectly - - - - - 34badd6a by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #142: (random 0) signals incorrect error - - - - - cab4212d by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 237d001c by Raymond Toy at 2022-10-16T11:12:14-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 82ac3a68 by Raymond Toy at 2022-10-16T11:12:14-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 7 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/irrat.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - tests/filesys.lisp - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,7 +80,8 @@ linux:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out linux:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -950,7 +950,11 @@ File after it was renamed." (let* ((original (truename file)) (original-namestring (unix-namestring original t)) - (new-name (merge-pathnames new-name file)) + ;; First, merge NEW-FILE-NAME with *DEFAULT-PATHNAME-DEFAULTS* to + ;; fill in the missing components and then merge again with + ;; the FILE to get any missing components from FILE. + (new-name (merge-pathnames (merge-pathnames new-name) + file)) (new-namestring (unix-namestring new-name nil))) (unless new-namestring (error 'simple-file-error @@ -1474,4 +1478,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== src/code/irrat.lisp ===================================== @@ -510,12 +510,12 @@ (* base power) (exp (* power (* (log2 base 1w0) (log 2w0)))))) (((foreach fixnum (or bignum ratio) single-float) - (foreach (complex single-float))) + (foreach (complex rational) (complex single-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (exp (* power (log base))))) (((foreach (complex rational) (complex single-float)) - (foreach single-float (complex single-float))) + (foreach single-float (complex rational) (complex single-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm (coerce base '(complex single-float)) power) @@ -537,7 +537,7 @@ (exp (* power (log (coerce base '(complex double-double-float)))))))) (((foreach (complex double-float)) (foreach single-float double-float - (complex single-float) (complex double-float))) + (complex rational) (complex single-float) (complex double-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm base power) @@ -552,7 +552,7 @@ (exp (* power (log (coerce base '(complex double-double-float)))))))) #+double-double (((foreach (complex double-double-float)) - (foreach float (complex float))) + (foreach float (complex float) (complex rational))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm base power) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,8 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn ===================================== tests/issues.lisp ===================================== @@ -579,3 +579,94 @@ with user-info = (unix:unix-getpwuid uid) while user-info finally (assert-false user-info))) + +(define-test issue.132.1 + (:tag :issues) + ;; From a message on cmucl-imp 2008/06/01. If "d1" is a directory, + ;; (rename "d1" "d2") should rename the directory "d1" to "d2". + ;; Previously that produced an error trying to rename "d1" to + ;; "d1/d2". + ;; + ;; Create the test directory (that is a subdirectory of "dir"). + (assert-true (ensure-directories-exist "dir/orig-dir/")) + (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) + (multiple-value-bind (defaulted-new-name old-truename new-truename) + ;; Rename "dir/orig-dir" to "orig/new-dir". + (rename-file "orig-dir/" "new-dir") + (let ((orig (merge-pathnames + (make-pathname :directory '(:relative "orig-dir")))) + (new (merge-pathnames + (make-pathname :directory '(:relative "new-dir"))))) + ;; Ensure that the rename worked and that the returned values + ;; have the expected values. + (assert-true defaulted-new-name) + (assert-equalp old-truename orig) + (assert-equalp new-truename new))))) + +(define-test issue.132.2 + (:tag :issues) + (assert-true (ensure-directories-exist "dir/orig.dir/")) + (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) + (multiple-value-bind (defaulted-new-name old-truename new-truename) + ;; Rename "dir/orig.dir" to "orig/new-dir". Since the + ;; original name has a pathname-name of "orig" and a + ;; pathname-type of "dir", the new file name is merged to + ;; produce a pathname-name of "new" with a pathname-type of + ;; "dir". + (rename-file "orig.dir" "new") + (let ((orig (merge-pathnames + (make-pathname :directory '(:relative "orig.dir")))) + (new (merge-pathnames + (make-pathname :directory '(:relative "new.dir"))))) + ;; Ensure that the rename worked and that the returned values + ;; have the expected values. + (assert-true defaulted-new-name) + (assert-equalp old-truename orig) + (assert-equalp new-truename new))))) + +(define-test issue.132.3 + (:tag :issues) + (assert-true (ensure-directories-exist "dir/orig.dir/")) + (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) + (multiple-value-bind (defaulted-new-name old-truename new-truename) + ;; Rename "dir/orig.dir/" to "orig/new". Note that the + ;; original name is "orig.dir/" which marks a directory so + ;; that when we merge the new name with the old to fill in + ;; missing components, there are none because the old name is + ;; a directory with no pathname-name or pathname-type, so the + ;; new name stays the same. + (rename-file "orig.dir/" "new") + (let ((orig (merge-pathnames + (make-pathname :directory '(:relative "orig.dir")))) + (new (merge-pathnames + (make-pathname :directory '(:relative "new"))))) + ;; Ensure that the rename worked and that the returned values + ;; have the expected values. + (assert-true defaulted-new-name) + (assert-equalp old-truename orig) + (assert-equalp new-truename new))))) + +(define-test issue.134 + (:tag :issues) + ;; Verify that we can compute (3+4*%i)^%i (in Maxima format). This + ;; can be written analytically as + ;; %i*%e^-atan(4/3)*sin(log(5))+%e^-atan(4/3)*cos(log(5)), so use + ;; %this as the reference value. + (let ((answer (complex (* (cos (log 5w0)) + (exp (- (atan (float (/ 4 3) 0w0))))) + (* (sin (log 5w0)) + (exp (- (atan (float (/ 4 3) 0w0)))))))) + (flet ((relerr (actual true) + ;; Return the relative error between ACTUAL and TRUE + (/ (abs (- actual true)) + (abs true)))) + (dolist (test '((#c(3 4) 3.5918w-8) + (#c(3.0 4) 3.5918w-8) + (#c(3d0 4) 9.2977w-17) + (#c(3w0 4) 0w0))) + (destructuring-bind (base eps) + test + (let* ((value (expt base #c(0 1))) + (err (relerr value answer))) + (assert-true (<= err eps) base err eps))))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/abf0b3dcc9b44454e6bbcb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/abf0b3dcc9b44454e6bbcb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0