builtins: test: Enhance with file tests.

* gash/guix-build-utils.scm (directory-exists?, executable-file?,
  symbolic-link?): Import from Guix.
* gash/builtins.scm (test-command): Use them to enhance with file test.
This commit is contained in:
Jan Nieuwenhuizen 2018-07-14 20:46:52 +02:00
parent 863b3b5908
commit 0cab9321b2
2 changed files with 64 additions and 4 deletions

View File

@ -240,28 +240,68 @@ Options:
(() #f) (() #f)
(args (args
(let* ((option-spec (let* ((option-spec
'((help) '((is-directory (single-char #\d))
(exists (single-char #\e))
(has-size (single-char #\s))
(help)
(is-directory (single-char #\d))
(is-file (single-char #\f))
(is-symbolic-link (single-char #\L))
(is-symbolic-link (single-char #\h))
(is-readable (single-char #\r))
(is-writable (single-char #\w))
(is-exeutable (single-char #\x))
(version))) (version)))
(options (getopt-long (cons "ls" args) option-spec)) (options (getopt-long (cons "ls" args) option-spec))
(help? (option-ref options 'help #f)) (help? (option-ref options 'help #f))
(version? (option-ref options 'version #f)) (version? (option-ref options 'version #f))
(files (option-ref options '() '()))) (files (option-ref options '() '()))
(file (and (pair? files) (car files))))
(cond (help? (display "Usage: test [EXPRESSION] (cond (help? (display "Usage: test [EXPRESSION]
Options: Options:
-d FILE FILE exists and is a directory
-e FILE FILE exists
-f FILE FILE exists and is a regular file
-h FILE FILE exists and is a symbolic link (same as -L)
-L FILE FILE exists and is a symbolic link (same as -h)
-r FILE FILE exists and read permission is granted
-s FILE FILE exists and has a size greater than zero
-w FILE FILE exists and write permission is granted
-x FILE FILE exists and execute (or search) permission is granted
--help display this help and exit --help display this help and exit
--version display version information and exit --version display version information and exit
")) "))
(version? (format #t "test (GASH) ~a\n" %version)) (version? (format #t "test (GASH) ~a\n" %version))
((null? files) #f) ((null? files) #f)
(else ((and (= (length files) 3)
(member (cadr files) '("=" "==")))
(match files (match files
((or (left "=" right) ((or (left "=" right)
(left "==" right)) (left "==" right))
(equal? left right)) (equal? left right))
(expression (expression
(let ((status (sh-exec `(pipeline (command ',expression))))) (let ((status (sh-exec `(pipeline (command ',expression)))))
(zero? status)))))))))) (zero? status)))))
((not (= (length files) 1))
(format (current-error-port) "test: too many files: ~a\n" files)
1)
((option-ref options 'is-directory #f)
(directory-exists? file))
((option-ref options 'exists #f)
(file-exists? file))
((option-ref options 'is-symbolic-link #f)
(symbolic-link? file))
((option-ref options 'is-readable #f)
(access? file R_OK))
((option-ref options 'has-size #f)
(and (file-exists? file)
(not (zero? (stat:size (stat file))))))
((option-ref options 'is-writable #f)
(access? file W_OK))
((option-ref options 'is-exeutable #f)
(access? file X_OK))
(else #f))))))
(define (PATH-search-path program) (define (PATH-search-path program)
(search-path (string-split (getenv "PATH") #\:) program)) (search-path (string-split (getenv "PATH") #\:) program))

View File

@ -39,6 +39,10 @@
dump-port dump-port
file-name-predicate file-name-predicate
find-files find-files
directory-exists?
executable-file?
symbolic-link?
)) ))
;;; Commentary: ;;; Commentary:
@ -49,6 +53,22 @@
;;; Directories. ;;; Directories.
;;; ;;;
(define (directory-exists? dir)
"Return #t if DIR exists and is a directory."
(let ((s (stat dir #f)))
(and s
(eq? 'directory (stat:type s)))))
(define (executable-file? file)
"Return #t if FILE exists and is executable."
(let ((s (stat file #f)))
(and s
(not (zero? (logand (stat:mode s) #o100))))))
(define (symbolic-link? file)
"Return #t if FILE is a symbolic link (aka. \"symlink\".)"
(eq? (stat:type (lstat file)) 'symlink))
(define (file-name-predicate regexp) (define (file-name-predicate regexp)
"Return a predicate that returns true when passed a file name whose base "Return a predicate that returns true when passed a file name whose base
name matches REGEXP." name matches REGEXP."