Add shell module

* geesh/shell.scm: New file.
* tests/shell.scm: New file.
* Makefile.am: Add them.
* tests/config.scm.in: New file.
* configure.ac: Add it.
* .gitignore: Add its generated form.
* .dir-locals.el: Add indentation rule for 'make-script'.

.dir-locals.el

@@ -7,4 +7,5 @@
    (eval . (put '<sh-until> 'scheme-indent-function 1))
    (eval . (put '<sh-while> 'scheme-indent-function 1))
    (eval . (put '<sh-with-redirects> 'scheme-indent-function 1))
-   (eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1)))))
+   (eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1))
+   (eval . (put 'make-script 'scheme-indent-function 1)))))

.gitignore

@@ -14,4 +14,5 @@ lcov.info
 pre-inst-env
 scripts/geesh
 tests/*.trs
+tests/config.scm
 tools/coverage

Makefile.am

@@ -41,6 +41,7 @@ MODULES =                                       \
   geesh/lexer.scm                               \
   geesh/parser.scm                              \
   geesh/repl.scm                                \
+  geesh/shell.scm                               \
   geesh/word.scm
 
 bin_SCRIPTS =                                   \
@@ -51,6 +52,7 @@ TESTS =                                         \
   tests/lexer.scm                               \
   tests/parser.scm                              \
   tests/repl.scm                                \
+  tests/shell.scm                               \
   tests/word.scm
 
 CLEANFILES =                                    \

configure.ac

@@ -13,6 +13,7 @@ AM_CONDITIONAL([HAVE_GENHTML], [test -n $GENHTML])
 AC_CONFIG_FILES([Makefile])
 AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
 AC_CONFIG_FILES([scripts/geesh], [chmod +x scripts/geesh])
+AC_CONFIG_FILES([tests/config.scm])
 AC_CONFIG_FILES([tools/coverage], [chmod +x tools/coverage])
 
 AC_OUTPUT

geesh/shell.scm

@@ -0,0 +1,33 @@
+(define-module (geesh shell)
+  #:use-module (geesh environment)
+  #:use-module (ice-9 match)
+  #:export (sh:exec-let
+            sh:exec))
+
+;;; Commentary:
+;;;
+;;; This module provides functions for executing Shell language
+;;; constructs.
+;;;
+;;; Code:
+
+(define (exec-utility env bindings path name args)
+  "Execute @var{path} as a subprocess with environment @var{env} and
+extra environment variables @var{bindings}.  The first argument given
+to the new process will be @var{name}, and the rest of the arguments
+will be @var{args}."
+  (let ((utility-env (environment->environ env bindings)))
+    (match (primitive-fork)
+      (0 (apply execle path utility-env name args))
+      (pid (match-let (((pid . status) (waitpid pid)))
+             (set-var! env "?" (number->string (status:exit-val status))))))))
+
+(define (sh:exec-let env bindings name . args)
+  "Execute @var{name} with arguments @var{args}, environment
+@var{env}, and extra environment variable bindings @var{bindings}."
+  (exec-utility env bindings name name args))
+
+(define (sh:exec env name . args)
+  "Execute @var{name} with arguments @var{args} and environment
+@var{env}."
+  (apply sh:exec-let env '() name args))

tests/config.scm.in

@@ -0,0 +1,4 @@
+(define-module (tests config)
+  #:export (*guile-path*))
+
+(define *guile-path* "@GUILE@")

tests/shell.scm

@@ -0,0 +1,97 @@
+;;; The Geesh Shell Interpreter
+;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
+;;;
+;;; This file is part of Geesh.
+;;;
+;;; Geesh is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Geesh is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Geesh.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-shell)
+  #:use-module (geesh environment)
+  #:use-module (geesh shell)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (srfi srfi-64)
+  #:use-module (tests automake)
+  #:use-module (tests config))
+
+;;; Commentary:
+;;;
+;;; Tests for the shell module.
+;;;
+;;; Code:
+
+(define (make-temporary-directory)
+  (let loop ((name (tmpnam)))
+    (catch 'system-error
+      (lambda ()
+        (mkdir name #o700)
+        name)
+      (lambda args
+        (unless (= (system-error-errno args) EEXIST)
+          (apply throw args))
+        (loop (tmpnam))))))
+
+(define (delete-recursively path)
+  (define enter? (const #t))
+  (define (leaf path stat acc) (delete-file path) #f)
+  (define down (const #f))
+  (define (up path stat acc) (rmdir path) #f)
+  (define skip (const #f))
+  (define (error path stat errno result)
+    (scm-error 'system-error
+               "delete-recursively"
+               "~A" `(,strerror errno)
+               `(,errno)))
+  (file-system-fold enter? leaf down up skip error #f path))
+
+(define (call-with-temporary-directory proc)
+  (let* ((directory (make-temporary-directory))
+         (result (with-continuation-barrier
+                  (lambda ()
+                    (proc directory)))))
+    (delete-recursively directory)
+    result))
+
+(define (%make-script object . forms)
+  (define (write-script port)
+    (chmod port #o755)
+    (format port "#!~a --no-auto-compile~%!#~%~%" *guile-path*)
+    (for-each (lambda (form)
+                (write form port)
+                (newline port))
+              forms))
+  (match object
+    ((? port?) (write-script object))
+    ((? string?) (call-with-output-file object write-script))))
+
+(define-syntax-rule (make-script path form form1 ...)
+  (%make-script path `form `form1 ...))
+
+(test-begin "shell")
+
+(test-assert "Executes a utility by absolute path"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((utility (string-append directory "/utility"))
+           (sentinal (string-append directory "/sentinal.txt"))
+           (env (make-environment '())))
+       (make-script utility
+         (with-output-to-file ,sentinal
+           (lambda ()
+             (display "x"))))
+       (sh:exec env utility)
+       (file-exists? sentinal)))))
+
+(test-end)