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/b627c1e36a02140adc62649...