Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl
Commits:
51d4f25b by Raymond Toy at 2022-09-02T16:00:01-07:00
Simplify code and use strdup to copy the strings
Reorder the code for os_software_version to keep all the
UNAME_RELEASE_AND_VERSION code together. When
UNAME_RELEASE_AND_VERSION is not set, use strdup to copy the release.
In os_software_type, use strdup to copy the OS name, instead of
malloc+strcpy.
- - - - -
1 changed file:
- src/lisp/os-common.c
Changes:
=====================================
src/lisp/os-common.c
=====================================
@@ -740,19 +740,15 @@ os_software_version()
int version_length;
#if defined(UNAME_RELEASE_AND_VERSION)
version_length = strlen(uts.release) + strlen(uts.version) + 2;
-#else
- version_length = strlen(uts.version) + 1;
-#endif
version = malloc(version_length);
if (version) {
-#if defined(UNAME_RELEASE_AND_VERSION)
strcpy(version, uts.release);
strcat(version, " ");
strcat(version, uts.version);
+ }
#else
- strcpy(version, uts.version);
+ version = strdup(uts.version);
#endif
- }
}
return version;
@@ -768,10 +764,7 @@ os_software_type()
status = uname(&uts);
if (status == 0) {
- os_name = malloc(strlen(uts.sysname) + 1);
- if (os_name) {
- strcpy(os_name, uts.sysname);
- }
+ os_name = strdup(uts.sysname);
}
return os_name;
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/51d4f25b5c61298d978e7df…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/51d4f25b5c61298d978e7df…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl
Commits:
a6ef2b38 by Raymond Toy at 2022-09-02T10:21:26-07:00
Use strdup to copy the author field.
- - - - -
1 changed file:
- src/lisp/os-common.c
Changes:
=====================================
src/lisp/os-common.c
=====================================
@@ -782,10 +782,7 @@ os_file_author(const char *path)
}
if (result) {
- author = malloc(strlen(result->pw_name) + 1);
- if (author) {
- strcpy(author, result->pw_name);
- }
+ author = strdup(result->pw_name);
}
if (buf) {
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a6ef2b384cc21b539b90aba…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a6ef2b384cc21b539b90aba…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl
Commits:
288e8373 by Raymond Toy at 2022-09-01T16:30:52-07:00
Fix typo in allocation for author
The closing paren is in the wrong place so we didn't allocate enough
memory to hold the author field.
- - - - -
1 changed file:
- src/lisp/os-common.c
Changes:
=====================================
src/lisp/os-common.c
=====================================
@@ -786,7 +786,7 @@ os_file_author(const char *path)
fprintf(stderr, "Allocate %d bytes for author\n",
strlen(result->pw_name + 1));
- author = malloc(strlen(result->pw_name + 1));
+ author = malloc(strlen(result->pw_name) + 1);
if (author) {
fprintf(stderr, "author = %p\n", author);
strcpy(author, result->pw_name);
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/288e837309e3792ba4aaf76…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/288e837309e3792ba4aaf76…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl
Commits:
399b8755 by Raymond Toy at 2022-08-31T12:47:39-07:00
Some debugging prints in os_file_author
When running CI on linux, there's a SIGABRT:
```
ISSUE.127: 1 assertions passed, 0 failed.
buf2 = 0x807e500, size 1024
malloc(): invalid next size (unsorted)
| Execution error:
|
Error in function UNIX::SIGABRT-HANDLER: SIGABRT at #xF7FC6559.
|
ISSUE.130: 1 assertions passed, 0 failed, and an execution error.
```
But I don't have this problem running on the same linux box. So I
have to do this the hard way using CI and prints to figure it out.
- - - - -
1 changed file:
- src/lisp/os-common.c
Changes:
=====================================
src/lisp/os-common.c
=====================================
@@ -783,13 +783,20 @@ os_file_author(const char *path)
}
if (result) {
+ fprintf(stderr, "Allocate %d bytes for author\n",
+ strlen(result->pw_name + 1));
+
author = malloc(strlen(result->pw_name + 1));
if (author) {
+ fprintf(stderr, "author = %p\n", author);
strcpy(author, result->pw_name);
}
}
- free(buf);
+ fprintf(stderr, "Free buf %p\n", buf);
+ if (buf) {
+ free(buf);
+ }
return author;
}
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/399b87553f410ad600ab381…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/399b87553f410ad600ab381…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl
Commits:
3de2409f by Raymond Toy at 2022-08-31T08:59:18-07:00
Add some test for file-author
In particular, check that (file-author ".") returns a non-NIL value.
(The first implementation failed this test because the unix-namestring
was "" instead of ".")
Also add a simple test for a non-ascii file name name in the file
"tests/안녕하십니까.txt" ("Hello" in Korean). This should not fail.
- - - - -
2 changed files:
- tests/issues.lisp
- + tests/안녕하십니까.txt
Changes:
=====================================
tests/issues.lisp
=====================================
@@ -579,3 +579,11 @@
with user-info = (unix:unix-getpwuid uid)
while user-info
finally (assert-false user-info)))
+
+(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/-/commit/3de2409f2e4921ee7de6b8f…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3de2409f2e4921ee7de6b8f…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl
Commits:
6f25328f by Raymond Toy at 2022-08-31T08:20:55-07:00
Move software-version to misc.lisp
The version in misc.lisp can handle all OSes, so remove the different
implementations in the foo-os.lisp files in favor of the one in
misc.lisp.
- - - - -
4 changed files:
- src/code/bsd-os.lisp
- src/code/linux-os.lisp
- src/code/misc.lisp
- src/code/sunos-os.lisp
Changes:
=====================================
src/code/bsd-os.lisp
=====================================
@@ -42,32 +42,13 @@
#+executable
(register-lisp-runtime-feature :executable)
-#+nil
-(setq *software-type* #+OpenBSD "OpenBSD"
- #+NetBSD "NetBSD"
- #+freebsd "FreeBSD"
- #+Darwin "Darwin"
- #-(or freebsd NetBSD OpenBSD Darwin) "BSD")
-
-(defvar *software-version* nil "Version string for supporting software")
-
-(defun software-version ()
- "Returns a string describing version of the supporting software."
- (unless *software-version*
- (setf *software-version*
- (string-trim '(#\newline)
- (with-output-to-string (stream)
- (run-program "/usr/bin/uname"
- '("-r")
- :output stream)))))
- *software-version*)
-
;;; OS-Init initializes our operating-system interface. It sets the values
;;; of the global port variables to what they should be and calls the functions
;;; that set up the argument blocks for the server interfaces.
(defun os-init ()
+ ;; Decache version on save, because it might not be the same when we restart.
(setf *software-version* nil))
;;; GET-SYSTEM-INFO -- Interface
=====================================
src/code/linux-os.lisp
=====================================
@@ -26,46 +26,11 @@
(register-lisp-feature :elf)
(register-lisp-runtime-feature :executable)
-;;(setq *software-type* "Linux")
-
-(defvar *software-version* nil
- "Version string for supporting software")
-
-;;; Instead of reading /proc/version (which has some bugs with
-;;; select() in Linux kernel 2.6.x) and instead of running uname -r,
-;;; let's just get the info from uname().
-(defun software-version ()
- "Returns a string describing version of the supporting software."
- (unless *software-version*
- (setf *software-version*
- (multiple-value-bind (sysname nodename release version)
- (unix:unix-uname)
- (declare (ignore sysname nodename))
- (concatenate 'string release " " version))))
- *software-version*)
-
-#+nil
-(defun software-version ()
- "Returns a string describing version of the supporting software."
- (unless *software-version*
- (setf *software-version*
- (let (version)
- (unwind-protect
- (progn
- (setf version
- (alien:alien-funcall
- (alien:extern-alien "os_software_version"
- (function (alien:* c-call:c-string)))))
- (unless (zerop (sap-int (alien:alien-sap version)))
- (alien:cast version c-call:c-string)))
- (when version
- (alien:free-alien version)))))
- *software-version*))
-
-
;;; OS-Init initializes our operating-system interface.
;;;
-(defun os-init () nil)
+(defun os-init ()
+ ;; Decache version on save, because it might not be the same when we restart.
+ (setf *software-version* nil))
;;; GET-SYSTEM-INFO -- Interface
=====================================
src/code/misc.lisp
=====================================
@@ -204,6 +204,26 @@
(alien:free-alien software-type))))))
*software-type*)
+(defvar *software-version* nil
+ _N"Version string for supporting software")
+
+(defun software-version ()
+ _N"Returns a string describing version of the supporting software."
+ (unless *software-version*
+ (setf *software-version*
+ (let (version)
+ (unwind-protect
+ (progn
+ (setf version
+ (alien:alien-funcall
+ (alien:extern-alien "os_software_version"
+ (function (alien:* c-call:c-string)))))
+ (unless (zerop (sap-int (alien:alien-sap version)))
+ (alien:cast version c-call:c-string)))
+ (when version
+ (alien:free-alien version)))))
+ *software-version*))
+
(defvar *short-site-name* (intl:gettext "Unknown")
"The value of SHORT-SITE-NAME. Set in library:site-init.lisp.")
=====================================
src/code/sunos-os.lisp
=====================================
@@ -31,21 +31,6 @@
#+executable
(register-lisp-runtime-feature :executable)
-;;(setq *software-type* "SunOS")
-
-(defvar *software-version* nil "Version string for supporting software")
-
-(defun software-version ()
- "Returns a string describing version of the supporting software."
- (unless *software-version*
- (setf *software-version*
- (multiple-value-bind (sysname nodename release version)
- (unix:unix-uname)
- (declare (ignore sysname nodename))
- (concatenate 'string release " " version))))
- *software-version*)
-
-
;;; OS-INIT -- interface.
;;;
;;; Other OS dependent initializations.
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b7…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b7…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl
Commits:
882fa7ec by Raymond Toy at 2022-08-31T08:06:20-07:00
Don't set *software-type* in sunos-os.lisp
- - - - -
1 changed file:
- src/code/sunos-os.lisp
Changes:
=====================================
src/code/sunos-os.lisp
=====================================
@@ -31,7 +31,7 @@
#+executable
(register-lisp-runtime-feature :executable)
-(setq *software-type* "SunOS")
+;;(setq *software-type* "SunOS")
(defvar *software-version* nil "Version string for supporting software")
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/882fa7ec9609cfdd01b08a7…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/882fa7ec9609cfdd01b08a7…
You're receiving this email because of your account on gitlab.common-lisp.net.