GitLab

at 2023-11-29T07:54:12-08:00

Move get-user-homedir-pathname to SYSTEM package in os.lisp

Update exports.lisp, filesys.lisp, and os.lisp appropriately.

Move the unit tests from tests/filesys.lisp to tests/os.lisp.

Remove some trailing blanks

Update pot files due to the refactoring.

 	   "DESCRIBE-EXTERNAL-FORMAT"

 	   "LIST-ALL-EXTERNAL-FORMATS"

 	   "STRING-ENCODE" "STRING-DECODE"

-	   "SET-SYSTEM-EXTERNAL-FORMAT")

-  ;; File sys items

-  (:export "GET-USER-HOMEDIR-PATHNAME"))

+	   "SET-SYSTEM-EXTERNAL-FORMAT"))

 (defpackage "STREAM"

   (:import-from "SYSTEM" "LISP-STREAM")

 	   "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS"

 	   "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS"

 	   "GET-PAGE-SIZE" "GET-SYSTEM-INFO"

+           "GET-USER-HOMEDIR-PATHNAME"

 	   "IGNORE-INTERRUPT"

 	   "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"

 	   "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"

 				(go retry))))))

 	 ;; Only the first path in a search-list is considered.

 	 (return (values pathspec created-p))))))
-

-;;; GET-USER-HOMEDIR-PATHNAME  -- Public

-;;;

-(defun get-user-homedir-pathname (name)

-  _N"Get the user home directory for user named NAME.  Two values are

-  returned: the pathname of the home directory and a status code.  If

-  the home directory does not exist NIL is returned.  The status is 0

-  if no errors occurred.  Otherwise a non-zero value is returned.

-  Examining errno may give information about what failed."

-  (alien:with-alien ((status c-call:int))

-    (let ((result

-            (alien:alien-funcall

-             (alien:extern-alien "os_get_user_homedir"

-                                 (function c-call:c-string

-                                           c-call:c-string

-                                           (* c-call:int)))

-             name

-             (alien:addr status))))

-      (if (and (zerop status) result)

-          (values (pathname

-                   (concatenate 'string

-                                result

-                                "/"))

-                  status)

-          (values result status)))))
 	(error (intl:gettext "Unix system call getrusage failed: ~A.")

 	       (unix:get-unix-error-msg utime)))

       (values utime stime major-fault))))

+

+;;; GET-USER-HOMEDIR-PATHNAME  -- Public

+;;;

+(defun get-user-homedir-pathname (name)

+  _N"Get the user home directory for user named NAME.  Two values are

+  returned: the pathname of the home directory and a status code.  If

+  the home directory does not exist NIL is returned.  The status is 0

+  if no errors occurred.  Otherwise a non-zero value is returned.

+  Examining errno may give information about what failed."

+  (alien:with-alien ((status c-call:int))

+    (let ((result

+            (alien:alien-funcall

+             (alien:extern-alien "os_get_user_homedir"

+                                 (function c-call:c-string

+                                           c-call:c-string

+                                           (* c-call:int)))

+             name

+             (alien:addr status))))

+      (if (and (zerop status) result)

+          (values (pathname

+                   (concatenate 'string

+                                result

+                                "/"))

+                  status)

+          (values result status)))))
 msgid "Unix system call getrusage failed: ~A."

 msgstr ""

+#: src/code/os.lisp

+msgid ""

+"Get the user home directory for user named NAME.  Two values are\n"

+"  returned: the pathname of the home directory and a status code.  If\n"

+"  the home directory does not exist NIL is returned.  The status is 0\n"

+"  if no errors occurred.  Otherwise a non-zero value is returned.\n"

+"  Examining errno may give information about what failed."

+msgstr ""

+
 msgid "Can't create directory ~A."

 msgstr ""

-#: src/code/filesys.lisp

-msgid ""

-"Get the user home directory for user named NAME.  Two values are\n"

-"  returned: the pathname of the home directory and a status code.  If\n"

-"  the home directory does not exist NIL is returned.  The status is 0\n"

-"  if no errors occurred.  Otherwise a non-zero value is returned.\n"

-"  Examining errno may give information about what failed."

-msgstr ""

-

 #: src/code/load.lisp

 msgid "The default for the :IF-SOURCE-NEWER argument to load."

 msgstr ""

 	 (assert-equal "/tmp/foo/bar/symlink"

 		       (ext:unix-namestring "/tmp/foo/bar/symlink" nil)))

     (unix:unix-unlink "/tmp/foo/bar/symlink")))
-

-(define-test user-homedir.1

-  "Test user-homedir"

-  (:tag :issues)

-  ;; Simple test to see if get-user-homedir-pathname returns the

-  ;; expected value.  Use getuid and getpwuid to figure out what the

-  ;; name and home directory should be.

-  (let* ((uid (unix:unix-getuid))

-         (user-info (unix:unix-getpwuid uid)))

-    (assert-true uid)

-    (assert-true user-info)

-    (let* ((info-dir (unix:user-info-dir user-info))

-           (info-name (unix:user-info-name user-info))

-           (expected-home-pathname (pathname

-                                    (concatenate 'string info-dir "/"))))

-      (multiple-value-bind (home-pathname status)

-          (ext:get-user-homedir-pathname info-name)

-        (assert-true info-dir)

-        (assert-true info-name)

-

-        (assert-equal home-pathname expected-home-pathname)

-        (assert-eql status 0)))))

-

-(define-test user-homedir.2

-  "Test user-homedir"

-  (:tag :issues)

-  ;; Simple test to see if get-user-homedir-pathname returns the expected

-  ;; value for a user that does not exist.  Well, we assume such a

-  ;; user doesn't exist.

-      (multiple-value-bind (home-pathname status)

-          (ext:get-user-homedir-pathname "zotuserunknown")

-        (assert-eql home-pathname nil)

-        (assert-eql status 0)))    

-  
+(defpackage :os-tests

+  (:use :cl :lisp-unit))

+

+(in-package "OS-TESTS")

+

+

+(define-test user-homedir.1

+  "Test user-homedir"

+  (:tag :issues)

+  ;; Simple test to see if get-user-homedir-pathname returns the

+  ;; expected value.  Use getuid and getpwuid to figure out what the

+  ;; name and home directory should be.

+  (let* ((uid (unix:unix-getuid))

+         (user-info (unix:unix-getpwuid uid)))

+    (assert-true uid)

+    (assert-true user-info)

+    (let* ((info-dir (unix:user-info-dir user-info))

+           (info-name (unix:user-info-name user-info))

+           (expected-home-pathname (pathname

+                                    (concatenate 'string info-dir "/"))))

+      (multiple-value-bind (home-pathname status)

+          (system:get-user-homedir-pathname info-name)

+        (assert-true info-dir)

+        (assert-true info-name)

+

+        (assert-equal home-pathname expected-home-pathname)

+        (assert-eql status 0)))))

+

+(define-test user-homedir.2

+  "Test user-homedir"

+  (:tag :issues)

+  ;; Simple test to see if get-user-homedir-pathname returns the expected

+  ;; value for a user that does not exist.  Well, we assume such a

+  ;; user doesn't exist.

+      (multiple-value-bind (home-pathname status)

+          (system:get-user-homedir-pathname "zotuserunknown")

+        (assert-eql home-pathname nil)

+        (assert-eql status 0)))

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl

Commits:

7 changed files:

Changes: