mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
4e5cdedc03
By convention, a library meant for testing exports "run-tests". Also by convention, assume the test for (foo bar) is (foo bar-test), keeping the test in the same directory and avoiding confusion since (chibi test) is not a test for (chibi). - Avoids the hack of "load"ing test, with resulting namespace complications. - Allows keeping tests together with the libraries. - Allows setting up test hooks before running. - Allows implicit inference of test locations when using above conventions.
35 lines
1.6 KiB
Scheme
35 lines
1.6 KiB
Scheme
(define-library (chibi system-test)
|
|
(export run-tests)
|
|
(import (chibi) (chibi system) (only (chibi test) test-begin test test-end))
|
|
(begin
|
|
(define (run-tests)
|
|
(test-begin "system")
|
|
|
|
(test #t (user? (user-information (current-user-id))))
|
|
(test #f (user? #f))
|
|
(test #f (user? (list #f)))
|
|
(test #t (string? (user-name (user-information (current-user-id)))))
|
|
(test #t (string? (user-password (user-information (current-user-id)))))
|
|
(test #t (integer? (user-id (user-information (current-user-id)))))
|
|
(test #t (integer? (user-group-id (user-information (current-user-id)))))
|
|
(test #t (string? (user-gecos (user-information (current-user-id)))))
|
|
(test #t (string? (user-home (user-information (current-user-id)))))
|
|
(test #t (string? (user-shell (user-information (current-user-id)))))
|
|
|
|
(test (current-user-id) (user-id (user-information (current-user-id))))
|
|
(test (current-group-id) (user-group-id (user-information (current-user-id))))
|
|
|
|
(test (user-id (user-information (current-user-id)))
|
|
(user-id (user-information (user-name (user-information (current-user-id))))))
|
|
|
|
(test #t (integer? (current-session-id)))
|
|
|
|
;; stress test user-name
|
|
(test (user-name (user-information (current-user-id)))
|
|
(user-name (user-information (current-user-id))))
|
|
(define u (user-information (current-user-id)))
|
|
(test (user-name u) (user-name (user-information (current-user-id))))
|
|
(define un (user-name (user-information (current-user-id))))
|
|
(test un (user-name (user-information (current-user-id))))
|
|
|
|
(test-end))))
|