[Git][cmucl/cmucl][issue-135-unix-namestring-dot] 7 commits: Fix #146: CI passes incorrectly
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Wed Oct 19 17:52:30 UTC 2022
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/24cc68e54ee74ed8c74150e48c092c08b97feaae...3f663e8f1a152d9590a550f5db1d5394eb67694e
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/24cc68e54ee74ed8c74150e48c092c08b97feaae...3f663e8f1a152d9590a550f5db1d5394eb67694e
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221019/e79cfa08/attachment-0001.html>
More information about the cmucl-cvs
mailing list