Update NEWS for 0.3.0.

* NEWS (release 0.3.0): New section.

ChangeLog

@@ -7,7 +7,7 @@ If not, see the Git commit log:
 
 The following notice will be appended to the generated ChangeLog.
 
-Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+Copyright © 2019-2022 Timothy Sample <samplet@ngyro.com>
 Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 
 Copying and distribution of this file, with or without modification,

Makefile.am

@@ -35,6 +35,7 @@ EXTRA_DIST +=                                   \
 #####################
 
 SOURCES =                                       \
+  gash/arithmetic.scm                           \
   gash/built-ins/break.scm                      \
   gash/built-ins/cd.scm                         \
   gash/built-ins/colon.scm                      \
@@ -59,6 +60,7 @@ SOURCES =                                       \
   gash/built-ins/umask.scm                      \
   gash/built-ins/unset.scm                      \
   gash/built-ins/utils.scm                      \
+  gash/built-ins/wait.scm                       \
   gash/built-ins.scm                            \
   gash/compat/hash-table.scm                    \
   gash/compat/srfi-43.scm                       \
@@ -74,7 +76,8 @@ SOURCES =                                       \
   gash/readline.scm                             \
   gash/repl.scm                                 \
   gash/shell.scm                                \
-  gash/word.scm
+  gash/word.scm                                 \
+  language/sh/spec.scm
 
 bin_SCRIPTS =                                   \
   scripts/gash
@@ -121,6 +124,7 @@ override $(srcdir)/doc/version.texi:
 # Tests
 #######
 
+AM_TESTS_ENVIRONMENT = SYSTEM_SHELL='$(SHELL)'; export SYSTEM_SHELL;
 TEST_EXTENSIONS = .scm .org
 SCM_LOG_COMPILER = $(top_builddir)/pre-inst-env $(GUILE)
 AM_SCM_LOG_FLAGS = --no-auto-compile
@@ -140,6 +144,7 @@ check-gash:
 	SHELL=gash $(top_builddir)/pre-inst-env $(top_builddir)/check.sh
 
 UNIT_TESTS =                                    \
+  tests/unit/eval.scm                           \
   tests/unit/lexer.scm                          \
   tests/unit/parser.scm                         \
   tests/unit/pattern.scm                        \

NEWS

@@ -1,6 +1,32 @@
 All The Latest Gash News
 ************************
 
+Noteworthy changes in release 0.3.0 (2022-02-11)
+================================================
+
+New features
+
+  - Arithmetic expansion.
+  - Simple asynchronous commands.
+  - A language specification is now provided, allowing you to use the
+    evaluator from the Guile REPL by typing ",L sh".
+  - Redirects now honor the 'noclobber' option.
+  - The 'wait' built-in.
+  - The 'umask' built-in can now display the current umask.
+
+Bug fixes
+
+  - An empty command will now reset the status.
+  - The 'read-sh' procedure now reads from 'current-input-port' by
+    default (before it used 'current-output-port').
+
+Miscellaneous improvements
+
+  - Various performance improvements.
+  - Word expansion has been split into two steps, paving the way for a
+    compiler.
+  - Guile 3.0 is now explicitly supported.
+
 Noteworthy changes in release 0.2.0 (2019-12-15)
 ================================================
 

build-aux/gitlab-ci.yml

@@ -22,6 +22,7 @@ before_script:
   - apt-get update -qq && apt-get install -y -qq
       autoconf
       automake
+      git
       guile-${TEST_GUILE_VERSION}-dev
       make
       pkg-config

configure.ac

@@ -25,7 +25,7 @@ AC_CONFIG_AUX_DIR([build-aux])
 AM_INIT_AUTOMAKE([color-tests silent-rules -Wall -Werror])
 AM_SILENT_RULES([yes])
 
-GUILE_PKG([2.2 2.0])
+GUILE_PKG([3.0 2.2 2.0])
 GUILE_PROGS
 
 AC_ARG_VAR([GUILD], [guild (Guile compiler) command])

doc/gash.texi

@@ -203,8 +203,8 @@ exceptional cases, like @code{"$@@"} and when @code{$IFS} is
 manipulated.
 
 You can set variables and mark them read-only or exported.  Many
-special variables are available, and about half of the variable
-operators (like @code{$@{VARIABLE+alternate@}}) work.
+special variables are available, and all of the variable operators
+(like @code{$@{VARIABLE+alternate@}}) work.
 
 Both types of command substitution work (that is, @code{$(...)} and
 @code{`...`}), and can even be nested.
@@ -247,6 +247,22 @@ Print each command that is executed.
 @end table
 
 
+@node Using Gash from the Guile REPL
+@section Using Gash from the Guile REPL
+
+Gash defines a language specification that extends Guile, allowing you
+to use shell syntax from the REPL.  This is accomplished by using the
+@code{language} REPL command:
+
+@example
+scheme@atchar{}(guile-user)> ,language sh
+Happy hacking with Guile as Shell!  To switch back, type `,L scheme'.
+sh@atchar{}(guile-user)> echo "Hello Gash!"
+Hello Gash!
+$1 = 0
+@end example
+
+
 @node Missing features
 @section Missing features
 
@@ -258,10 +274,7 @@ exhaustive, but covers the most glaring omissions.
 @itemize @bullet
 
 @item
-Arithmetic substitution.
-
-@item
-Asynchronous commands and job control.
+Job control.
 
 @item
 Alias creation and substitution.
@@ -275,11 +288,6 @@ the prompt variables (@code{$PS*}).
 @item
 Tilde expansion.
 
-@item
-Variable pattern operators and assertion operators.  This means that
-@code{$@{FOO%pattern@}} and the like do not work, and neither does
-@code{$@{FOO?@}}.
-
 @item
 Multi-line commands from the readline interface.  If you press
 @key{Enter} in the middle of a command (e.g., from within an
@@ -442,7 +450,8 @@ cat <<EOF > hello.scm
 (display "Hello world!\n")
 EOF
 @result{}
-(<sh-with-redirects> ((<< 0 (<sh-quote> "(display \"Hello world!\\n\")\n"))
+(<sh-with-redirects> ((<< 0 (<sh-quote>
+                             "(display \"Hello world!\\n\")\n"))
                       (> 1 "hello.scm"))
   (<sh-exec> "cat"))
 
@@ -451,7 +460,8 @@ hi=Howdy; echo $hi world!
 EOF
 @result{}
 (<sh-with-redirects> ((<< 0 (<sh-quote>
-                             ("hi=Howdy; echo " (<sh-ref> "hi") " world!\n")))
+                             ("hi=Howdy; echo " (<sh-ref> "hi")
+                              " world!\n")))
                       (> 1 "hello.sh"))
   (<sh-exec> "cat"))
 
@@ -583,7 +593,7 @@ cut -d ' ' -f 4 < ice-cream.txt \
   | sed 's/mint/peanut butter/g'
 @result{}
 (<sh-pipeline>
- (<sh-with-redirects> ((< 0 "flavors.txt"))
+ (<sh-with-redirects> ((< 0 "ice-cream.txt"))
    (<sh-exec> "cut" "-d" (<sh-quote> " ") "-f" "4"))
  (<sh-exec> "grep" "chocolate")
  (<sh-exec> "sed" (<sh-quote> "s/mint/peanut butter/g")))
@@ -730,6 +740,7 @@ word  ::= string
         | (word ...)
         | ('<sh-quote> word)
         | ('<sh-cmd-sub> sync ...)
+        | ('<sh-arithmetic> word)
         | ('<sh-ref> var)
         | ('<sh-ref-or> var [word])
         | ('<sh-ref-or*> var [word])

doc/syntax.txt

@@ -48,6 +48,7 @@ word  ::= string
         | (word ...)
         | ('<sh-quote> word)
         | ('<sh-cmd-sub> sync ...)
+        | ('<sh-arithmetic> word)
         | ('<sh-ref> var)
         | ('<sh-ref-or> var [word])
         | ('<sh-ref-or*> var [word])

gash/arithmetic.scm

@@ -0,0 +1,268 @@
+;;; Gash -- Guile As SHell
+;;; Copyright © 2020, 2021 Timothy Sample <samplet@ngyro.com>
+;;;
+;;; This file is part of Gash.
+;;;
+;;; Gash 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.
+;;;
+;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gash arithmetic)
+  #:use-module (ice-9 i18n)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (system base lalr)
+  #:export (read-arithmetic))
+
+;;; Commentary:
+;;;
+;;; This module contains the lexer and parser for reading arithmetic
+;;; expansions.
+;;;
+;;; Code:
+
+(define nonzero-digit?
+  (let ((nonzero-digits (string->char-set "123456789")))
+    (lambda (chr)
+      "Check if @var{chr} is a nonzero digit."
+      (char-set-contains? nonzero-digits chr))))
+
+(define* (lex-number str #:optional (start 0) (end (string-length str)))
+  "Read a number token from @var{str} and return two values: the token
+and its length.  If a number cannot be read, then the resulting token
+will be @code{#f} and the length will be zero."
+  (define (->token offset base)
+    (let ((str* (substring str (+ start offset) end)))
+      (receive (n count) (locale-string->integer str* base)
+        (if n
+            (values (make-lexical-token 'NUMBER #f n) (+ offset count))
+            (values #f 0)))))
+  (match (string-ref str start)
+    (#\0 (match (and (< (1+ start) end) (string-ref str (1+ start)))
+           ((or #\x #\X) (->token 2 16))
+           (_ (->token 0 8))))
+    ((? nonzero-digit?) (->token 0 10))
+    (_ (values #f 0))))
+
+(define *operators*
+  `(("(" . LPAREN)
+    (")" . RPAREN)
+    ("~" . BITNOT)
+    ("!" . LOGNOT)
+    ("*" . *)
+    ("/" . /)
+    ("%" . %)
+    ("+" . +)
+    ("-" . -)
+    ("<<" . <<)
+    (">>" . >>)
+    ("<" . <)
+    ("<=" . <=)
+    (">" . >)
+    (">=" . >=)
+    ("==" . ==)
+    ("!=" . !=)
+    ("&" . BITAND)
+    ("^" . BITXOR)
+    ("|" . BITIOR)
+    ("&&" . LOGAND)
+    ("||" . LOGIOR)
+    ("?" . ?)
+    (":" . :)
+    ("=" . =)
+    ("*=" . *=)
+    ("/=" . /=)
+    ("%=" . %=)
+    ("+=" . +=)
+    ("-=" . -=)
+    ("<<=" . <<=)
+    (">>=" . >>=)
+    ("&=" . BITAND-ASSIGN)
+    ("^=" . BITXOR-ASSIGN)
+    ("|=" . BITIOR-ASSIGN)))
+
+(define* (operator-prefix? str #:optional (start 0) (end (string-length str)))
+  "Check if @var{str} is a prefix of an arithmetic operator."
+  (any (cut string-prefix? str <> start end)
+       (map car *operators*)))
+
+(define* (lex-operator str #:optional (start 0) (end (string-length str)))
+  "Read an operator token from @var{str} and return two values: the
+token and its length.  If an operator cannot be read, then the resulting
+token will be @code{#f} and the length will be zero."
+  (define (->token op)
+    (if (string-null? op)
+        (values #f 0)
+        (values (make-lexical-token (assoc-ref *operators* op) #f op)
+                (string-length op))))
+  (let loop ((k start) (acc ""))
+    (if (< k end)
+        (let ((next (string-append acc (string (string-ref str k)))))
+          (if (operator-prefix? next)
+              (loop (1+ k) next)
+              (->token acc)))
+        (->token acc))))
+
+(define name-start-char?
+  (let ((char-set:name-start
+         (char-set-intersection char-set:ascii
+                                (char-set-union char-set:letter
+                                                (char-set #\_)))))
+    (lambda (chr)
+      "Check if @var{chr} is a valid first character for a name."
+      (and (char? chr)
+           (char-set-contains? char-set:name-start chr)))))
+
+(define name-char?
+  (let ((char-set:name
+         (char-set-intersection char-set:ascii
+                                (char-set-union char-set:letter+digit
+                                                (char-set #\_)))))
+    (lambda (chr)
+      "Check if @var{chr} is a valid character for a name."
+      (and (char? chr)
+           (char-set-contains? char-set:name chr)))))
+
+(define* (lex-name str #:optional (start 0) (end (string-length str)))
+  "Read a name token from @var{str} and return two values: the token and
+its length.  If a name cannot be read, then the resulting token will be
+@code{#f} and the length will be zero."
+  (match (string-ref str start)
+    ((? name-start-char? ch)
+     (let loop ((k (1+ start)) (acc (list ch)))
+       (match (and (< k end) (string-ref str k))
+         ((? name-char? ch) (loop (1+ k) (cons ch acc)))
+         (_ (let ((result (reverse-list->string acc)))
+              (values (make-lexical-token 'NAME #f result)
+                      (string-length result)))))))
+    (_ (values #f 0))))
+
+(define (make-lexer str)
+  "Return a lexer that reads tokens from @var{str}.  This lexer is a
+stateful thunk that returns the next token each time it is called.  It
+is suitable to be used with an @code{lalr-parser}."
+  (define %lexers (list lex-number lex-operator lex-name))
+  (define idx 0)
+  (lambda ()
+    (set! idx (string-index str char-set:graphic idx))
+    (if (and idx (< idx (string-length str)))
+        (let loop ((lexers %lexers))
+          (match lexers
+            (() (error "could not read arithmetic substitution" str idx))
+            ((lex . rest)
+             (receive (token count) (lex str idx)
+               (if token
+                   (begin
+                     (set! idx (+ idx count))
+                     token)
+                   (loop rest))))))
+        '*eoi*)))
+
+(define (make-ref name)
+  "Return a Scheme expression that looks up @var{name} in the current
+Gash environment, returning zero if @var{name} is not set."
+  `(or (string->number (getvar ,name "0")) 0))
+
+(define* (make-assign name expr #:optional make-expr)
+  "Return a Scheme expression that sets @var{name} to the result of
+@var{expr} in the current Gash environment.  Optionally, @var{make-expr}
+can be used to adjust the result of @var{expr} while setting
+@var{name}."
+  `(let ((result ,(match make-expr
+                    ((? symbol?) `(,make-expr ,(make-ref name) ,expr))
+                    ((? procedure?) (make-expr (make-ref name) expr))
+                    (#f expr))))
+     (setvar! ,name (number->string result))
+     result))
+
+(define (make-bool expr)
+  "Return a Scheme expression that converts the Boolean expression
+@var{expr} into a number (one for true, zero for false)."
+  `(if ,expr 1 0))
+
+(define (nonzero? expr)
+  "Return a Scheme expression that checks if @var{expr} is an expression
+that returns a nonzero number."
+  `(not (zero? ,expr)))
+
+(define (make-parser)
+  "Create a parser that reads arithmetic expansion expressions and
+returns equivalent Scheme expressions."
+  (lalr-parser
+   (NAME
+    NUMBER
+    LPAREN
+    RPAREN
+    (right: = *= /= %= += -= <<= >>=
+            BITAND-ASSIGN BITXOR-ASSIGN BITIOR-ASSIGN)
+    (right: ? :)
+    (left: LOGIOR)
+    (left: LOGAND)
+    (left: BITIOR)
+    (left: BITXOR)
+    (left: BITAND)
+    (left: == !=)
+    (left: < <= > >=)
+    (left: << >>)
+    (left: + -)
+    (left: * / %)
+    (nonassoc: LOGNOT)
+    (nonassoc: BITNOT)
+    (nonassoc: unary-)
+    (nonassoc: unary+))
+   (expr
+    (NAME) : (make-ref $1)
+    (NUMBER) : $1
+    (LPAREN expr RPAREN) : $2
+    (+ expr (prec: unary+)) : `(+ ,$2)
+    (- expr (prec: unary-)) : `(- ,$2)
+    (BITNOT expr) : `(lognot ,$2)
+    (LOGNOT expr) : (make-bool `(zero? ,$2))
+    (expr * expr) : `(* ,$1 ,$3)
+    (expr / expr) : `(quotient ,$1 ,$3)
+    (expr % expr) : `(modulo ,$1 ,$3)
+    (expr + expr) : `(+ ,$1 ,$3)
+    (expr - expr) : `(- ,$1 ,$3)
+    (expr << expr) : `(ash ,$1 ,$3)
+    (expr >> expr) : `(ash ,$1 (- ,$3))
+    (expr < expr) : (make-bool `(< ,$1 ,$3))
+    (expr <= expr) : (make-bool `(<= ,$1 ,$3))
+    (expr > expr) : (make-bool `(> ,$1 ,$3))
+    (expr >= expr) : (make-bool `(>= ,$1 ,$3))
+    (expr == expr) : (make-bool `(= ,$1 ,$3))
+    (expr != expr) : (make-bool `(not (= ,$1 ,$3)))
+    (expr BITAND expr) : `(logand ,$1 ,$3)
+    (expr BITXOR expr) : `(logxor ,$1 ,$3)
+    (expr BITIOR expr) : `(logior ,$1 ,$3)
+    (expr LOGAND expr) : (make-bool `(and ,(nonzero? $1) ,(nonzero? $3)))
+    (expr LOGIOR expr) : (make-bool `(or ,(nonzero? $1) ,(nonzero? $3)))
+    (expr ? expr : expr) : `(if ,(nonzero? $1) ,$3 ,$5)
+    (NAME = expr) : (make-assign $1 $3)
+    (NAME *= expr) : (make-assign $1 $3 '*)
+    (NAME /= expr) : (make-assign $1 $3 'quotient)
+    (NAME %= expr) : (make-assign $1 $3 'modulo)
+    (NAME += expr) : (make-assign $1 $3 '+)
+    (NAME -= expr) : (make-assign $1 $3 '-)
+    (NAME <<= expr) : (make-assign $1 $3 'ash)
+    (NAME >>= expr) : (make-assign $1 $3 (lambda (x y) `(ash ,x (- ,y))))
+    (NAME BITAND-ASSIGN expr) : (make-assign $1 $3 'logand)
+    (NAME BITXOR-ASSIGN expr) : (make-assign $1 $3 'logxor)
+    (NAME BITIOR-ASSIGN expr) : (make-assign $1 $3 'logior))))
+
+(define (read-arithmetic str)
+  "Read @var{str} as an arithmetic expansion expression and return an
+equivalent Scheme expression."
+  (let ((lexer (make-lexer str))
+        (parser (make-parser)))
+    (parser lexer error)))

gash/built-ins.scm

@@ -69,7 +69,7 @@
     ("type" . ,(@@ (gash built-ins type) main))
     ("umask" . ,(@@ (gash built-ins umask) main))
     ("unalias" . ,undefined)
-    ("wait" . ,undefined)
+    ("wait" . ,(@@ (gash built-ins wait) main))
     ;; Other built-ins.
     ("echo" . ,(@@ (gash built-ins echo) main))))
 

gash/built-ins/umask.scm

@@ -1,5 +1,5 @@
 ;;; Gash -- Guile As SHell
-;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2018, 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of Gash.
 ;;;
@@ -26,8 +26,17 @@
 ;;;
 ;;; Code:
 
+(define (umask->octal-string mask)
+  (let* ((octal (number->string mask 8))
+         (pad-count (- 4 (string-length octal)))
+         (pad (make-string pad-count #\0)))
+    (string-append pad octal)))
+
 (define (main . args)
   (match args
+    (()
+     (format #t "~a~%" (umask->octal-string (umask)))
+     EXIT_SUCCESS)
     ((mask)
      (let ((n (string->number mask 8)))
        (cond

gash/built-ins/wait.scm

@@ -0,0 +1,40 @@
+;;; Gash -- Guile As SHell
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;;
+;;; This file is part of Gash.
+;;;
+;;; Gash 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.
+;;;
+;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gash built-ins wait)
+  #:use-module (gash built-ins utils)
+  #:use-module (gash compat)
+  #:use-module (ice-9 match))
+
+;;; Commentary:
+;;;
+;;; The 'wait' utility.
+;;;
+;;; Code:
+
+(define (main . args)
+  (let ((pids (map string->nonnegative-integer args)))
+    (match pids
+      ((pid)
+       (match (false-if-exception (waitpid pid))
+         (#f 127)
+         ((_ . status) (status:exit-val status))))
+      (_ (format (current-error-port)
+                 "~a: wait: Invalid arguments."
+                 (car (program-arguments)))
+         EXIT_FAILURE))))

gash/environment.scm

@@ -53,7 +53,10 @@
             set-atexit!
             sh:exit
             *fd-count*
-            fd->current-port))
+            fd->current-port
+            get-last-job
+            set-last-job!
+            reap-child-processes!))
 
 ;;; Commentary:
 ;;;
@@ -438,3 +441,21 @@ status.  If not called from within @code{call-with-return}, return
 corresponding to the the Shell file descriptor @var{fd}.  The value of
 @var{fd} must be a nonnegative integer less than @code{*fd-count*}."
       (vector-ref cps fd))))
+
+
+;;; Jobs.
+
+(define *last-job* #f)
+
+(define (get-last-job)
+  *last-job*)
+
+(define (set-last-job! pid)
+  (set! *last-job* pid))
+
+(define (reap-child-processes!)
+  (let loop ()
+    (match (false-if-exception (waitpid WAIT_ANY WNOHANG))
+      (#f #t)
+      ((0 . _) #t)
+      ((pid . status) (loop)))))

gash/eval.scm

@@ -18,14 +18,17 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gash eval)
+  #:use-module (gash arithmetic)
   #:use-module (gash compat)
   #:use-module (gash environment)
+  #:use-module (gash pattern)
   #:use-module (gash shell)
   #:use-module (gash word)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (eval-sh))
+  #:export (eval-word
+            eval-sh))
 
 ;;; Commentary:
 ;;;
@@ -33,6 +36,91 @@
 ;;;
 ;;; Code:
 
+(define eval-cmd-sub
+  (make-parameter (lambda (exps) (throw 'eval-cmd-sub-unset))))
+
+(define (string-not-null? str)
+  "Check if @var{str} is a non-null string."
+  (and (string? str) (not (string-null? str))))
+
+(define (word->qword word)
+  "Convert @var{word} into a qword by resolving all parameter, command,
+and arithmetic substitions."
+  (match word
+    ((? string?)
+     word)
+    (('<sh-quote> quoted-word)
+     `(<sh-quote> ,(word->qword quoted-word)))
+    (('<sh-cmd-sub> . exps)
+     ((eval-cmd-sub) exps))
+    (('<sh-arithmetic> word)
+     (let* ((arithmetic (expand-word word #:output 'string))
+            (expr `(begin (use-modules (gash environment))
+                          (number->string ,(read-arithmetic arithmetic)))))
+       (eval expr (interaction-environment))))
+    (('<sh-ref> name)
+     (parameter-ref name ""))
+    (('<sh-ref-or> name default)
+     (or (parameter-ref name)
+         (word->qword (or default ""))))
+    (('<sh-ref-or*> name default)
+     (let ((value (parameter-ref name)))
+       (if (string-not-null? value)
+           value
+           (word->qword (or default "")))))
+    (('<sh-ref-or!> name default)
+     (or (parameter-ref name)
+         (let ((new-value (expand-word (or default "")
+                                       #:output 'string #:rhs-tildes? #t)))
+           (setvar! name new-value)
+           new-value)))
+    (('<sh-ref-or!*> name default)
+     (let ((value (parameter-ref name)))
+       (if (string-not-null? value)
+           value
+           (let ((new-value (expand-word (or default "")
+                                         #:output 'string #:rhs-tildes? #t)))
+             (setvar! name new-value)
+             new-value))))
+    (('<sh-ref-assert> name message)
+     (or (parameter-ref name)
+         (let ((message* (expand-word message #:output 'string)))
+           (throw 'shell-error (format #f "~a: ~a" name message*)))))
+    (('<sh-ref-assert*> name message)
+     (let ((value (parameter-ref name)))
+       (if (string-not-null? value)
+           value
+           (let ((message* (expand-word message #:output 'string)))
+             (throw 'shell-error (format #f "~a: ~a" name message*))))))
+    (('<sh-ref-and> name value)
+     (or (and (parameter-ref name)
+              (word->qword (or value "")))
+         ""))
+    (('<sh-ref-and*> name value)
+     (if (string-not-null? (parameter-ref name))
+         (word->qword (or value ""))
+         ""))
+    (('<sh-ref-except-min> name pattern-word)
+     (let ((pattern (expand-word pattern-word #:output 'pattern)))
+       (pattern-drop-right pattern (parameter-ref name ""))))
+    (('<sh-ref-except-max> name pattern-word)
+     (let ((pattern (expand-word pattern-word #:output 'pattern)))
+       (pattern-drop-right pattern (parameter-ref name "") #:greedy? #t)))
+    (('<sh-ref-skip-min> name pattern-word)
+     (let ((pattern (expand-word pattern-word #:output 'pattern)))
+       (pattern-drop pattern (parameter-ref name ""))))
+    (('<sh-ref-skip-max> name pattern-word)
+     (let ((pattern (expand-word pattern-word #:output 'pattern)))
+       (pattern-drop pattern (parameter-ref name "") #:greedy? #t)))
+    (('<sh-ref-length> name)
+     (number->string (string-length (parameter-ref name ""))))
+    (_ (map word->qword word))))
+
+(define* (expand-word word #:key (output 'fields) (rhs-tildes? #f))
+  "Expand @var{word} into a list of fields."
+  (let ((qword (word->qword word)))
+    (expand-qword qword #:output output #:rhs-tildes? rhs-tildes?)))
+
 (define* (eval-word word #:key (output 'fields) (rhs-tildes? #f)
                     (on-command-substitution noop))
   (parameterize ((eval-cmd-sub (lambda (exps)
@@ -59,7 +147,7 @@
   ;; XXX: See comment in `exps->thunk'.
   (if exp
       (lambda () (eval-sh exp))
-      noop))
+      (lambda () (set-status! 0))))
 
 (define (exps->thunk exps)
   ;; XXX: It probably makes more sense to exclude '#f' expressions at
@@ -68,13 +156,15 @@
       (match (filter values exps)
         (() noop)
         (exps (lambda () (eval-sh `(<sh-begin> ,@exps)))))
-      noop))
+      (lambda () (set-status! 0))))
 
 (define (eval-sh exp)
   "Evaluate the Shell expression @var{exp}."
   (match exp
     (('<sh-and> exp1 exp2)
      (sh:and (exp->thunk exp1) (exp->thunk exp2)))
+    (('<sh-async> sub-exp)
+     (sh:async (exp->thunk sub-exp)))
     (('<sh-begin> . sub-exps)
      (for-each eval-sh sub-exps))
     (('<sh-case> word (pattern-lists . sub-exp-lists) ...)

gash/gash.scm

@@ -130,7 +130,8 @@ There is NO WARRANTY, to the extent permitted by law.
                                                 (not (string-null? line)))
                                        (unless parse?
                                          (eval-sh ast))
-                                       (add-history line))
+                                       (add-history line)
+                                       (reap-child-processes!))
                                      (loop (let ((previous (if ast "" (string-append line "\n")))
                                                  (next (readline (if ast (prompt) "> "))))
                                              (if (eof-object? next) next

gash/lexer.scm

@@ -1,5 +1,5 @@
 ;;; Gash -- Guile As SHell
-;;; Copyright © 2017, 2018 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2017, 2018, 2020, 2021 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of Gash.
 ;;;
@@ -100,7 +100,12 @@
 (define (operator-prefix? str)
   (any (cut string-prefix? str <>) (map car *operators*)))
 
-(define operator-prefix-char? (compose operator-prefix? string))
+(define operator-prefix-char?
+  (let ((prefix-chars (delete-duplicates
+                       (map (match-lambda
+                              ((str . _) (string-ref str 0)))
+                            *operators*))))
+    (cut memv <> prefix-chars)))
 
 (define blank? (cut char-set-contains? char-set:blank <>))
 
@@ -166,7 +171,7 @@
               '()
               lst))
 
-(define (next-char port)
+(define-inlinable (next-char port)
   "Advance @var{port} by one character and return the lookahead
 character."
   (get-char port)
@@ -320,6 +325,48 @@ leading '$')."
       ((op "LINENO" x) `(,op ("LINENO" . ,(1+ (port-line port))) ,x))
       (_ result))))
 
+(define (get-arithmetic-expansion port)
+  "Get an arithmetic expansion from @var{port}."
+
+  (define (get-arithmetic-expansion-string port)
+    (let loop ((chr (lookahead-char port)) (acc '()))
+      (match chr
+        ((? eof-object?) (throw 'lex-error))
+        ((or #\( #\) #\$ #\` #\\) (list->string (reverse! acc)))
+        (_ (loop (next-char port) (cons chr acc))))))
+
+  (match (list (get-char port) (get-char port))
+    ((#\( #\()
+     (let loop ((chr (lookahead-char port)) (depth 0) (acc '()))
+       (match chr
+         (#\( (loop (next-char port) (1+ depth) (cons "(" acc)))
+         (#\) (cond
+               ((and (zero? depth) (equal? (next-char port) #\)))
+                (get-char port)
+                `(<sh-arithmetic>
+                  ,(match (join-contiguous-strings (reverse! acc))
+                     (() "")
+                     ((word) word)
+                     (words words))))
+               ((positive? depth)
+                (loop (next-char port) (1- depth) (cons ")" acc)))
+               (else
+                (throw 'lex-error))))
+         ((or #\$ #\`)
+          (let ((expansion (get-expansion port)))
+            (loop (lookahead-char port)
+                  depth
+                  (cons (or expansion (string chr)) acc))))
+         (#\\ (let ((escape (get-escape port
+                                        (cut member <> '(#\$ #\` #\\)))))
+                (loop (lookahead-char port) depth (append escape acc))))
+         (_ (let ((str (get-arithmetic-expansion-string port)))
+              (loop (lookahead-char port)
+                    depth
+                    (if (not (string-null? str))
+                        (cons str acc)
+                        acc)))))))))
+
 (define (get-bracketed-command port)
   "Get a bracketed command ('$(...)') from @var{port} (excluding the
 leading '$')."
@@ -347,7 +394,11 @@ they were quoted."
     (#\$ (begin
            (get-char port)
            (match (lookahead-char port)
-             (#\( (get-bracketed-command port))
+             (#\( (let ((next (next-char port)))
+                    (unget-char port #\()
+                    (match next
+                      (#\( (get-arithmetic-expansion port))
+                      (_ (get-bracketed-command port)))))
              (_ (get-parameter-expansion port)))))
     (#\` (get-backquoted-command port #:quoted? quoted?))))
 

gash/parser.scm

@@ -817,18 +817,15 @@ as escapable."
       (->command-list (parse port)))
     #:quoted? quoted?))
 
-(define* (read-sh #:optional (port #f))
+(define* (read-sh #:optional (port (current-input-port)))
   "Read a complete Shell command from @var{port} (or the current input
 port if @var{port} is unspecified)."
-
   (define stop? #f)
   (define (stop!) (set! stop? #t))
+  (parse port #:lex-hook (lambda (lex) (if stop? '*eoi* (lex)))
+         #:command-hook stop!))
 
-  (let* ((port (or port (current-output-port))))
-    (parse port #:lex-hook (lambda (lex) (if stop? '*eoi* (lex)))
-           #:command-hook stop!)))
-
-(define* (read-sh-all #:optional (port #f))
+(define* (read-sh-all #:optional (port (current-input-port)))
   "Read all complete Shell commands from @var{port} (or the current
 input port if @var{port} is unspecified)."
-  (->command-list (parse (or port (current-input-port)))))
+  (->command-list (parse port)))

gash/repl.scm

@@ -36,4 +36,5 @@
       ((? eof-object?) (sh:exit))
       (_ (if parse? (format #t "~a\n" exp)
              (eval-sh exp))
+         (reap-child-processes!)
          (loop (read-sh port))))))

gash/shell.scm

@@ -1,5 +1,5 @@
 ;;; Gash -- Guile As SHell
-;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2018, 2019, 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of Gash.
 ;;;
@@ -26,6 +26,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (sh:and
+            sh:async
             sh:case
             sh:cond
             sh:exec-let
@@ -191,8 +192,11 @@ if it is our responsibility to close the port."
     (('< (? integer? fd) (? string? filename))
      (make-processed-redir fd filename O_RDONLY))
     (('> (? integer? fd) (? string? filename))
-     ;; TODO: Observe noclobber.
-     (make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
+     (let* ((clobber-flags (logior O_WRONLY O_CREAT O_TRUNC))
+            (flags (if (getopt 'noclobber)
+                       (logior clobber-flags O_EXCL)
+                       clobber-flags)))
+       (make-processed-redir fd filename flags)))
     (('>! (? integer? fd) (? string? filename))
      (make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
     (('>> fd filename)
@@ -438,3 +442,12 @@ of each thunk sent to the input of the next thunk."
        (if (= (get-status) 0)
            (thunk)
            (loop tail))))))
+
+
+;;; Asynchronous commands.
+
+(define (sh:async thunk)
+  "Run @var{thunk} asynchronously."
+  (let ((pid (%subshell thunk)))
+    (set-last-job! pid)
+    (set-status! 0)))

gash/word.scm

@@ -23,8 +23,8 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (eval-cmd-sub
-            expand-word))
+  #:export (parameter-ref
+            expand-qword))
 
 ;;; Commentary:
 ;;;
@@ -99,7 +99,7 @@ in the string @var{ifs}."
     (string->char-set ifs))
 
   (define char-set:ifs/nw
-    (char-set-difference char-set:ifs char-set:whitespace))
+    (string->char-set (string-delete char-set:whitespace ifs)))
 
   (define (wedge-apart-quote qword)
     (let loop ((qword (normalize-word qword)) (acc '()))
@@ -236,15 +236,6 @@ faltten them."
               (() `(,(remove-quotes qword ifs)))
               (matches matches))))))
 
-(define eval-cmd-sub
-  ;; A procedure for evaluating (expanding) a command substitution.
-  ;; This is parameterized to avoid a circular dependency.
-  (make-parameter (lambda (exps) (throw 'eval-cmd-sub-unset))))
-
-(define (string-not-null? str)
-  "Check if @var{str} is a non-null string."
-  (and (string? str) (not (string-null? str))))
-
 (define* (parameter-ref name #:optional dflt)
   "Get the value of the variable or special parameter @var{name} from
 the environment.  If @var{name} is unset, return @var{dflt} if
@@ -259,6 +250,8 @@ provided or @code{#f} if not."
     ("#" (number->string (length (cdr (program-arguments)))))
     ("?" (number->string (get-status)))
     ("$" (number->string (get-root-pid)))
+    ("!" (cond ((get-last-job) => number->string)
+               (else dflt)))
     (("LINENO" . line) (number->string line))
     (x (let ((n (string->number x)))
          (if (and n (integer? n) (> n 0)
@@ -266,81 +259,10 @@ provided or @code{#f} if not."
              (list-ref (program-arguments) n)
              (getvar name dflt))))))
 
-(define (word->qword word)
-  "Convert @var{word} into a qword by resolving all parameter, command,
-and arithmetic substitions."
-  (match word
-    ((? string?)
-     word)
-    (('<sh-quote> quoted-word)
-     `(<sh-quote> ,(word->qword quoted-word)))
-    (('<sh-cmd-sub> . exps)
-     ((eval-cmd-sub) exps))
-    (('<sh-ref> name)
-     (parameter-ref name ""))
-    (('<sh-ref-or> name default)
-     (or (parameter-ref name)
-         (word->qword (or default ""))))
-    (('<sh-ref-or*> name default)
-     (let ((value (parameter-ref name)))
-       (if (string-not-null? value)
-           value
-           (word->qword (or default "")))))
-    (('<sh-ref-or!> name default)
-     (or (parameter-ref name)
-         (let ((new-value (expand-word (or default "")
-                                       #:output 'string #:rhs-tildes? #t)))
-           (setvar! name new-value)
-           new-value)))
-    (('<sh-ref-or!*> name default)
-     (let ((value (parameter-ref name)))
-       (if (string-not-null? value)
-           value
-           (let ((new-value (expand-word (or default "")
-                                         #:output 'string #:rhs-tildes? #t)))
-             (setvar! name new-value)
-             new-value))))
-    (('<sh-ref-assert> name message)
-     (or (parameter-ref name)
-         (let ((message* (expand-word message #:output 'string)))
-           (throw 'shell-error (format #f "~a: ~a" name message*)))))
-    (('<sh-ref-assert*> name message)
-     (let ((value (parameter-ref name)))
-       (if (string-not-null? value)
-           value
-           (let ((message* (expand-word message #:output 'string)))
-             (throw 'shell-error (format #f "~a: ~a" name message*))))))
-    (('<sh-ref-and> name value)
-     (or (and (parameter-ref name)
-              (word->qword (or value "")))
-         ""))
-    (('<sh-ref-and*> name value)
-     (if (string-not-null? (parameter-ref name))
-         (word->qword (or value ""))
-         ""))
-    (('<sh-ref-except-min> name pattern-word)
-     (let ((pattern (expand-word pattern-word #:output 'pattern)))
-       (pattern-drop-right pattern (parameter-ref name ""))))
-    (('<sh-ref-except-max> name pattern-word)
-     (let ((pattern (expand-word pattern-word #:output 'pattern)))
-       (pattern-drop-right pattern (parameter-ref name "") #:greedy? #t)))
-    (('<sh-ref-skip-min> name pattern-word)
-     (let ((pattern (expand-word pattern-word #:output 'pattern)))
-       (pattern-drop pattern (parameter-ref name ""))))
-    (('<sh-ref-skip-max> name pattern-word)
-     (let ((pattern (expand-word pattern-word #:output 'pattern)))
-       (pattern-drop pattern (parameter-ref name "") #:greedy? #t)))
-    (('<sh-ref-length> name)
-     (number->string (string-length (parameter-ref name ""))))
-    (_ (map word->qword word))))
-
-(define* (expand-word word #:key (output 'fields) (rhs-tildes? #f))
-  "Expand @var{word} into a list of fields."
-  ;; The value of '$IFS' may depend on side-effects performed during
-  ;; 'word->qword', so use 'let*' here.
-  (let* ((qword (word->qword word))
-         (ifs (getvar "IFS" (string #\space #\tab #\newline)))
-         (pwd (getvar "PWD")))
+(define* (expand-qword qword #:key (output 'fields) (rhs-tildes? #f))
+  "Expand @var{qword} into a list of fields."
+  (let ((ifs (getvar "IFS" (string #\space #\tab #\newline)))
+        (pwd (getvar "PWD")))
     (match output
       ('fields (if pwd
                    (append-map (cut expand-pathnames <> pwd ifs)

guix.scm

@@ -16,6 +16,7 @@
              (gnu packages guile)
              (gnu packages pkg-config)
              (gnu packages texinfo)
+             (gnu packages version-control)
              (guix build utils)
              (guix build-system gnu)
              (guix download)
@@ -56,7 +57,8 @@
         (error "Cannot make file selector")))
   (lambda (file stat)
     (let ((relative (substring file (1+ (string-length *srcdir*)))))
-      (or (eq? (stat:type stat) 'directory)
+      (or (string=? relative ".git")
+          (string-prefix? ".git/" relative)
           (member relative paths)))))
 
 (define guile-2.0.9
@@ -83,11 +85,12 @@
   (native-inputs
    `(("autoconf" ,autoconf)
      ("automake" ,automake)
+     ("git" ,git-minimal)
      ("lcov" ,lcov)                ; For generating test coverage data
      ("pkg-config" ,pkg-config)
      ("texinfo" ,texinfo)))
   (inputs
-   `(("guile" ,guile-2.2)))
+   `(("guile" ,guile-3.0)))
   (home-page "https://savannah.nongnu.org/projects/gash/")
   (synopsis "POSIX-compatible shell written in Guile Scheme")
   (description "Gash is a POSIX-compatible shell written in Guile

language/sh/spec.scm

@@ -0,0 +1,38 @@
+;;; Gash --- Guile As SHell
+;;; Copyright © 2020 Stephen J. Scheck <sscheck@singularsyntax.one>
+;;;
+;;; This file is part of Gash.
+;;;
+;;; Gash 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.
+;;;
+;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (language sh spec)
+  #:use-module (gash environment)
+  #:use-module (gash eval)
+  #:use-module (gash parser)
+  #:use-module (system base language)
+  #:export (sh))
+
+;;; Commentary:
+;;;
+;;; This module contains the language spec definition that extends
+;;; Guile allowing use of shell syntax from the REPL by invocation
+;;; of the ,language meta-command.
+;;;
+;;; Code:
+
+(define-language sh
+  #:title "Guile as Shell"
+  #:reader (lambda (port env) (read-sh port))
+  #:evaluator (lambda (x module) (eval-sh x) (get-status))
+  #:printer write)

tests/redirects.org

@@ -1,7 +1,7 @@
 ;;; Gash -- Guile As SHell
 ;;; Copyright © 2016, 2017, 2018 R.E.W. van Beusekom <rutger.van.beusekom@gmail.com>
 ;;; Copyright © 2018, 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2019, 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of Gash.
 ;;;
@@ -156,7 +156,7 @@
 :script:
 #+begin_src sh
   cat > $TEST_TMP/foo.sh <<EOF
-  #!/bin/sh
+  #!$SYSTEM_SHELL
   echo foo
   EOF
   chmod +x $TEST_TMP/foo.sh
@@ -167,3 +167,26 @@
 #+begin_example
   foo
 #+end_example
+
+* Redirecting output respects the noclobber option
+:script:
+#+begin_src sh
+  set -o noclobber
+  echo foo > $TEST_TMP/noclobber && echo created
+  cat $TEST_TMP/noclobber
+  echo bar >| $TEST_TMP/noclobber && echo clobbered
+  cat $TEST_TMP/noclobber
+  echo baz > $TEST_TMP/noclobber || echo not clobbered
+  cat $TEST_TMP/noclobber
+  rm -f $TEST_TMP/noclobber
+#+end_src
+:stdout:
+#+begin_example
+  created
+  foo
+  clobbered
+  bar
+  not clobbered
+  bar
+#+end_example
+

tests/spec/Makefile.am

@@ -36,6 +36,7 @@ TEST_EXTENSIONS = .sh
 SH_LOG_COMPILER = ./check-spec
 
 TESTS =                                         \
+    oil/spec/arith.test.sh                      \
     oil/spec/case_.test.sh                      \
     oil/spec/command-sub.test.sh                \
     oil/spec/errexit.test.sh                    \

tests/spec/oil.scm

@@ -1,5 +1,5 @@
 ;;; Gash -- Guile As SHell
-;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2018, 2019, 2021 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of Gash.
 ;;;
@@ -128,7 +128,54 @@
                                 out)))
                             (loop (read-line in 'concat) transformers))))))))
                  (tests-to-filter
-                  `(("spec/case_.test.sh"
+                  `(("spec/arith.test.sh"
+                     (;; These are Bash specific.
+                      ("Side Effect in Array Indexing")
+                      ("Array indexing in arith")
+                      ;; These go beyond POSIX.
+                      ("Invalid string to int with strict-arith")
+                      ("Preincrement")
+                      ("Postincrement")
+                      ("Increment undefined variables")
+                      ("Increment and decrement array")
+                      ("Increment undefined variables with nounset")
+                      ("Comma operator (borrowed from C)")
+                      ("Constants in base 36")
+                      ("Constants in bases 2 to 64")
+                      ("Dynamic base constants")
+                      ;; Following POSIX, we keep the quotes in the
+                      ;; expession.
+                      ("Constant with quotes like '1'"
+                       ("N-I bash/zsh" "N-I bash/zsh/gash"))
+                      ;; Follow bash/mksh and return status 1.
+                      ("No floating point"
+                       ("OK bash/mksh" "OK bash/mksh/gash"))
+                      ;; We do not support nounset yet.
+                      ("nounset with arithmetic")
+                      ;; We return 1 here.
+                      ("Invalid LValue"
+                       ("## status: 2" ,(string-append
+                                         "## status: 2\n"
+                                         "## OK gash status: 1\n")))
+                      ;; Follow Dash on these two.
+                      ("Invalid LValue that looks like array"
+                       ("N-I dash" "N-I dash/gash"))
+                      ("Invalid LValue: two sets of brackets"
+                       ("N-I dash" "N-I dash/gash"))
+                      ;; We do not support exponentiation.
+                      ("Exponentiation with **")
+                      ("Exponentiation operator has buggy precedence")
+                      ;; This test seems to be broken.
+                      ("Logical Ops Short Circuit"
+                       ("\\(\\(" "y=$(("))
+                      ;; Not sure about this one.  We only do one
+                      ;; layer of variable lookup.
+                      ("Bizarre recursive name evaluation - result of runtime parse/eval"
+                       ("## stdout: 6 6 6 6"
+                        ,(string-append
+                          "## stdout: 6 6 6 6\n"
+                          "## OK gash stdout: 6 1 1 1\n")))))
+                    ("spec/case_.test.sh"
                      (;; These two are Bash specific.
                       ("Case statement with ;;&")
                       ("Case statement with ;&")))

tests/unit/eval.scm

@@ -0,0 +1,460 @@
+;;; Gash -- Guile As SHell
+;;; Copyright © 2018, 2019, 2021 Timothy Sample <samplet@ngyro.com>
+;;;
+;;; This file is part of Gash.
+;;;
+;;; Gash 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.
+;;;
+;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-eval)
+  #:use-module (gash environment)
+  #:use-module (gash eval)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-64)
+  #:use-module (tests unit automake))
+
+;;; Commentary:
+;;;
+;;; Tests for the eval module.
+;;;
+;;; Code:
+
+(test-begin "eval")
+
+
+;;; Basic parameter references.
+;;;
+;;; FIXME: Test "nounset" ("set -u").
+
+(test-equal "Resolves parameters"
+  '("foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref> "x")))))
+
+(test-equal "Splits parameter results"
+  '("foo" "bar")
+  (with-variables '(("x" . "foo bar"))
+    (lambda ()
+      (eval-word '(<sh-ref> "x")))))
+
+(test-equal "Resolves quoted parameters"
+  '("foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-quote> (<sh-ref> "x"))))))
+
+(test-equal "Ignores spaces in quoted parameters"
+  '("foo bar")
+  (with-variables '(("x" . "foo bar"))
+    (lambda ()
+      (eval-word '(<sh-quote> (<sh-ref> "x"))))))
+
+(test-equal "Treats empty variables as nothing"
+  '()
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-ref> "x")))))
+
+(test-equal "Treats unset variables as nothing"
+  '()
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref> "x")))))
+
+(test-equal "Preserves empty variables when quoted"
+  '("")
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-quote> (<sh-ref> "x"))))))
+
+(test-equal "Preserves unset variables when quoted"
+  '("")
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-quote> (<sh-ref> "x"))))))
+
+
+;;; Parameter operations.
+
+;;; or
+
+(test-equal "Handles 'or' when parameter is set"
+  '("foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-or> "x" "bar")))))
+
+(test-equal "Handles 'or' when parameter is set and empty"
+  '()
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-ref-or> "x" "bar")))))
+
+(test-equal "Handles 'or' when parameter is unset"
+  '("bar")
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-or> "x" "bar")))))
+
+(test-equal "Handles 'or' fall-through without default"
+  '()
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-or> "x" #f)))))
+
+;;; or*
+
+(test-equal "Handles 'or*' when parameter is set"
+  '("foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-or*> "x" "bar")))))
+
+(test-equal "Handles 'or*' when parameter is set and empty"
+  '("bar")
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-ref-or*> "x" "bar")))))
+
+(test-equal "Handles 'or*' when parameter is unset"
+  '("bar")
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-or*> "x" "bar")))))
+
+(test-equal "Handles 'or*' fall-through without default"
+  '()
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-or*> "x" #f)))))
+
+;;; or!
+
+(test-equal "Handles 'or!' when parameter is set"
+  '(("foo") "foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!' when parameter is set and empty"
+  '(() "")
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!' when parameter is unset"
+  '(("bar") "bar")
+  (with-variables '()
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!' fall-through without default"
+  '(() "")
+  (with-variables '()
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!> "x" #f))
+            (getvar "x")))))
+
+;;; or!*
+
+(test-equal "Handles 'or!*' when parameter is set"
+  '(("foo") "foo")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!*> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!*' when parameter is set and empty"
+  '(("bar") "bar")
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!*> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!*' when parameter is unset"
+  '(("bar") "bar")
+  (with-variables '()
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!*> "x" "bar"))
+            (getvar "x")))))
+
+(test-equal "Handles 'or!*' fall-through without default"
+  '(() "")
+  (with-variables '()
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!*> "x" #f))
+            (getvar "x")))))
+
+(test-equal "Does not split fields on assignment"
+  '(("foo" "bar") "foo bar")
+  (with-variables '(("y" . "foo bar"))
+    (lambda ()
+      (list (eval-word '(<sh-ref-or!*> "x" (<sh-ref> "y")))
+            (getvar "x")))))
+
+;;; FIXME: Test 'assert'.
+
+;;; and
+
+(test-equal "Handles 'and' when parameter is set"
+  '("bar")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-and> "x" "bar")))))
+
+(test-equal "Handles 'and' when parameter is set and empty"
+  '("bar")
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-ref-and> "x" "bar")))))
+
+(test-equal "Handles 'and' when parameter is unset"
+  '()
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-and> "x" "bar")))))
+
+(test-equal "Handles 'and' fall-through without default"
+  '()
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-and> "x" #f)))))
+
+;;; and*
+
+(test-equal "Handles 'and*' when parameter is set"
+  '("bar")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-and*> "x" "bar")))))
+
+(test-equal "Handles 'and*' when parameter is set and empty"
+  '()
+  (with-variables '(("x" . ""))
+    (lambda ()
+      (eval-word '(<sh-ref-and*> "x" "bar")))))
+
+(test-equal "Handles 'and*' when parameter is unset"
+  '()
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-and*> "x" "bar")))))
+
+(test-equal "Handles 'and*' fall-through without default"
+  '()
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-and*> "x" #f)))))
+
+;;; length
+
+(test-equal "Handles 'length' when parameter is set"
+  '("3")
+  (with-variables '(("x" . "foo"))
+    (lambda ()
+      (eval-word '(<sh-ref-length> "x")))))
+
+(test-equal "Handles 'length' when parameter is unset"
+  '("0")
+  (with-variables '()
+    (lambda ()
+      (eval-word '(<sh-ref-length> "x")))))
+
+
+;;; Command substition.
+
+(test-equal "Resolves commands"
+  '("foo")
+  (eval-word '(<sh-cmd-sub> (<sh-exec> "echo" "foo"))))
+
+(test-equal "Splits command results"
+  '("foo" "bar")
+  (eval-word '(<sh-cmd-sub> (<sh-exec> "echo" "foo bar"))))
+
+(test-equal "Resolves quoted commands"
+  '("foo")
+  (eval-word '(<sh-quote> (<sh-cmd-sub> (<sh-exec> "echo" "foo")))))
+
+(test-equal "Ignores spaces in quoted commands"
+  '("foo bar")
+  (eval-word '(<sh-quote> (<sh-cmd-sub> (<sh-exec> "echo" "foo bar")))))
+
+
+;;; Arithmetic expansion.
+
+(test-equal "Evaluates arithmetic constant (decimal)"
+  '("42")
+  (eval-word '(<sh-arithmetic> "42")))
+
+(test-equal "Evaluates arithmetic constant (octal)"
+  '("34")
+  (eval-word '(<sh-arithmetic> "042")))
+
+(test-equal "Evaluates arithmetic constant (hexadecimal)"
+  '("66")
+  (eval-word '(<sh-arithmetic> "0x42")))
+
+;;; Binary (and tertiary) operators
+
+(test-equal "Evaluates arithmetic addition"
+  '("6")
+  (eval-word '(<sh-arithmetic> "2 + 4")))
+
+(test-equal "Evaluates arithmetic subtraction"
+  '("2")
+  (eval-word '(<sh-arithmetic> "4 - 2")))
+
+(test-equal "Evaluates arithmetic multiplication"
+  '("12")
+  (eval-word '(<sh-arithmetic> "3 * 4")))
+
+(test-equal "Evaluates arithmetic division"
+  '("6")
+  (eval-word '(<sh-arithmetic> "19 / 3")))
+
+(test-equal "Evaluates arithmetic modulo"
+  '("2")
+  (eval-word '(<sh-arithmetic> "32 % 3")))
+
+(test-equal "Evaluates arithmetic left shift"
+  '("12")
+  (eval-word '(<sh-arithmetic> "3 << 2")))
+
+(test-equal "Evaluates arithmetic right shift"
+  '("3")
+  (eval-word '(<sh-arithmetic> "15 >> 2")))
+
+(test-equal "Evaluates arithmetic greater than"
+  '("1")
+  (eval-word '(<sh-arithmetic> "5 > 3")))
+
+(test-equal "Evaluates arithmetic greater than or equal to"
+  '("0")
+  (eval-word '(<sh-arithmetic> "3 >= 5")))
+
+(test-equal "Evaluates arithmetic less than"
+  '("0")
+  (eval-word '(<sh-arithmetic> "5 < 3")))
+
+(test-equal "Evaluates arithmetic less than or equal to"
+  '("1")
+  (eval-word '(<sh-arithmetic> "3 <= 5")))
+
+(test-equal "Evaluates arithmetic equals"
+  '("0")
+  (eval-word '(<sh-arithmetic> "0 == 1")))
+
+(test-equal "Evaluates arithmetic not equals"
+  '("1")
+  (eval-word '(<sh-arithmetic> "0 != 1")))
+
+(test-equal "Evaluates arithmetic bitwise and"
+  '("4")
+  (eval-word '(<sh-arithmetic> "12 & 7")))
+
+(test-equal "Evaluates arithmetic bitwise inclusive or"
+  '("9")
+  (eval-word '(<sh-arithmetic> "8 | 1")))
+
+(test-equal "Evaluates arithmetic bitwise exclusive or"
+  '("5")
+  (eval-word '(<sh-arithmetic> "15 ^ 10")))
+
+(test-equal "Evaluates arithmetic logical and"
+  '("0")
+  (eval-word '(<sh-arithmetic> "0 && 1")))
+
+(test-equal "Evaluates arithmetic logical or"
+  '("1")
+  (eval-word '(<sh-arithmetic> "0 || 1")))
+
+(test-equal "Evaluates arithmetic conditional"
+  '("3")
+  (eval-word '(<sh-arithmetic> "0 ? 5 : 3")))
+
+;;; Variables
+
+(test-equal "Evaluates variables in arithmetic"
+  '("5")
+  (with-variables '(("x" . "3"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "x + 2")))))
+
+(test-equal "Evaluates non-numeric variables as zero in arithmetic"
+  '("0")
+  (with-variables '(("x" . "hello"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "x")))))
+
+;;; Assignments
+
+(for-each (match-lambda
+            ((op . result)
+             (test-equal (string-append "Evaluates arithmetic " op)
+               result
+               (with-variables '(("x" . "7"))
+                 (lambda ()
+                   (eval-word `(<sh-arithmetic>
+                                ,(string-append "x " op " 3")))
+                   (getvar "x"))))))
+          '(("=" . "3")
+            ("*=" . "21")
+            ("/=" . "2")
+            ("%=" . "1")
+            ("+=" . "10")
+            ("-=" . "4")
+            ("<<=" . "56")
+            (">>=" . "0")
+            ("&=" . "3")
+            ("^=" . "4")
+            ("|=" . "7")))
+
+;;; Unary operators
+
+(test-equal "Evaluates arithmetic negation"
+  '("-3")
+  (with-variables '(("x" . "3"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "-x")))))
+
+(test-equal "Evaluates arithmetic unary plus"
+  '("3")
+  (with-variables '(("x" . "3"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "+x")))))
+
+(test-equal "Evaluates arithmetic bitwise complement"
+  '("-6")
+  (eval-word `(<sh-arithmetic> "~5")))
+
+(test-equal "Evaluates arithmetic logical complement"
+  '("0")
+  (eval-word `(<sh-arithmetic> "!1")))
+
+(test-equal "Evaluates arithmetic negation on the left"
+  '("-12")
+  (with-variables '(("x" . "3"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "-x * 4")))))
+
+(test-equal "Evaluates arithmetic negation on the right"
+  '("0")
+  (with-variables '(("x" . "3"))
+    (lambda ()
+      (eval-word `(<sh-arithmetic> "3 + -x")))))
+
+(test-end "eval")

tests/unit/word.scm

@@ -113,351 +113,80 @@ variable @var{PWD} will be restored when leaving the extent of
 
 (test-equal "Converts a simple word (string) to a single field"
   '("foo")
-  (expand-word "foo"))
+  (expand-qword "foo"))
 
 (test-equal "Converts a simple word (list) to a single field"
   '("foo")
-  (expand-word '("foo")))
+  (expand-qword '("foo")))
 
 (test-equal "Concatenates contiguous parts into a single field"
   '("foobar")
-  (expand-word '("foo" "bar")))
+  (expand-qword '("foo" "bar")))
 
 (test-equal "Splits a word along unquoted spaces"
   '("foo" "bar")
-  (expand-word '("foo bar")))
+  (expand-qword '("foo bar")))
 
 (test-equal "Splits a word on leading space"
   '("foo" "bar")
-  (expand-word '("foo" " bar")))
+  (expand-qword '("foo" " bar")))
 
 (test-equal "Splits a word on trailing space"
   '("foo" "bar")
-  (expand-word '("foo " "bar")))
+  (expand-qword '("foo " "bar")))
 
 (test-equal "Ignores leading spaces"
   '("foo")
-  (expand-word '(" foo")))
+  (expand-qword '(" foo")))
 
 (test-equal "Ignores trailing spaces"
   '("foo")
-  (expand-word '("foo ")))
+  (expand-qword '("foo ")))
 
 (test-equal "Treats multiple spaces as a single space"
   '("foo" "bar")
-  (expand-word '("foo  bar")))
+  (expand-qword '("foo  bar")))
 
 (test-equal "Handles multiple joins and splits"
   '("hi_how" "are_you")
-  (expand-word '("hi_" "how are" "_you")))
+  (expand-qword '("hi_" "how are" "_you")))
 
 (test-equal "Handles nested lists"
   '("foo")
-  (expand-word '("f" ("oo"))))
+  (expand-qword '("f" ("oo"))))
 
 (test-equal "Handles nested lists for string output"
   "foo"
-  (expand-word '("f" ("oo")) #:output 'string))
+  (expand-qword '("f" ("oo")) #:output 'string))
 
 
 ;;; Quotes.
 
 (test-equal "Ignores spaces in quotes"
   '("foo bar")
-  (expand-word '(<sh-quote> "foo bar")))
+  (expand-qword '(<sh-quote> "foo bar")))
 
 (test-equal "Concatenates strings and quotes"
   '("foo bar")
-  (expand-word '("foo" (<sh-quote> " bar"))))
+  (expand-qword '("foo" (<sh-quote> " bar"))))
 
 (test-equal "Concatenates quotes"
   '("foo bar")
-  (expand-word '((<sh-quote> "foo") (<sh-quote> " bar"))))
+  (expand-qword '((<sh-quote> "foo") (<sh-quote> " bar"))))
 
 (test-equal "Handles nested quotes"
   '("foo bar")
-  (expand-word '(<sh-quote> (<sh-quote> "foo bar"))))
+  (expand-qword '(<sh-quote> (<sh-quote> "foo bar"))))
 
 (test-equal "Splits and concatenates words and quotes"
   '("foo" "bar")
-  (expand-word '((<sh-quote> "foo") " " (<sh-quote> "bar"))))
+  (expand-qword '((<sh-quote> "foo") " " (<sh-quote> "bar"))))
 
 
 ;;; Tildes.
 ;;;
 ;;; Not yet implemented.
 
-
-;;; Basic parameter references.
-;;;
-;;; FIXME: Test "nounset" ("set -u").
-
-(test-equal "Resolves parameters"
-  '("foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref> "x")))))
-
-(test-equal "Splits parameter results"
-  '("foo" "bar")
-  (with-variables '(("x" . "foo bar"))
-    (lambda ()
-      (expand-word '(<sh-ref> "x")))))
-
-(test-equal "Resolves quoted parameters"
-  '("foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-quote> (<sh-ref> "x"))))))
-
-(test-equal "Ignores spaces in quoted parameters"
-  '("foo bar")
-  (with-variables '(("x" . "foo bar"))
-    (lambda ()
-      (expand-word '(<sh-quote> (<sh-ref> "x"))))))
-
-(test-equal "Treats empty variables as nothing"
-  '()
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-ref> "x")))))
-
-(test-equal "Treats unset variables as nothing"
-  '()
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref> "x")))))
-
-(test-equal "Preserves empty variables when quoted"
-  '("")
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-quote> (<sh-ref> "x"))))))
-
-(test-equal "Preserves unset variables when quoted"
-  '("")
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-quote> (<sh-ref> "x"))))))
-
-
-;;; Parameter operations.
-
-;;; or
-
-(test-equal "Handles 'or' when parameter is set"
-  '("foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-or> "x" "bar")))))
-
-(test-equal "Handles 'or' when parameter is set and empty"
-  '()
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-ref-or> "x" "bar")))))
-
-(test-equal "Handles 'or' when parameter is unset"
-  '("bar")
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-or> "x" "bar")))))
-
-(test-equal "Handles 'or' fall-through without default"
-  '()
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-or> "x" #f)))))
-
-;;; or*
-
-(test-equal "Handles 'or*' when parameter is set"
-  '("foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-or*> "x" "bar")))))
-
-(test-equal "Handles 'or*' when parameter is set and empty"
-  '("bar")
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-ref-or*> "x" "bar")))))
-
-(test-equal "Handles 'or*' when parameter is unset"
-  '("bar")
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-or*> "x" "bar")))))
-
-(test-equal "Handles 'or*' fall-through without default"
-  '()
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-or*> "x" #f)))))
-
-;;; or!
-
-(test-equal "Handles 'or!' when parameter is set"
-  '(("foo") "foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!' when parameter is set and empty"
-  '(() "")
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!' when parameter is unset"
-  '(("bar") "bar")
-  (with-variables '()
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!' fall-through without default"
-  '(() "")
-  (with-variables '()
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!> "x" #f))
-            (getvar "x")))))
-
-;;; or!*
-
-(test-equal "Handles 'or!*' when parameter is set"
-  '(("foo") "foo")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!*> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!*' when parameter is set and empty"
-  '(("bar") "bar")
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!*> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!*' when parameter is unset"
-  '(("bar") "bar")
-  (with-variables '()
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!*> "x" "bar"))
-            (getvar "x")))))
-
-(test-equal "Handles 'or!*' fall-through without default"
-  '(() "")
-  (with-variables '()
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!*> "x" #f))
-            (getvar "x")))))
-
-(test-equal "Does not split fields on assignment"
-  '(("foo" "bar") "foo bar")
-  (with-variables '(("y" . "foo bar"))
-    (lambda ()
-      (list (expand-word '(<sh-ref-or!*> "x" (<sh-ref> "y")))
-            (getvar "x")))))
-
-;;; FIXME: Test 'assert'.
-
-;;; and
-
-(test-equal "Handles 'and' when parameter is set"
-  '("bar")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-and> "x" "bar")))))
-
-(test-equal "Handles 'and' when parameter is set and empty"
-  '("bar")
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-ref-and> "x" "bar")))))
-
-(test-equal "Handles 'and' when parameter is unset"
-  '()
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-and> "x" "bar")))))
-
-(test-equal "Handles 'and' fall-through without default"
-  '()
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-and> "x" #f)))))
-
-;;; and*
-
-(test-equal "Handles 'and*' when parameter is set"
-  '("bar")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-and*> "x" "bar")))))
-
-(test-equal "Handles 'and*' when parameter is set and empty"
-  '()
-  (with-variables '(("x" . ""))
-    (lambda ()
-      (expand-word '(<sh-ref-and*> "x" "bar")))))
-
-(test-equal "Handles 'and*' when parameter is unset"
-  '()
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-and*> "x" "bar")))))
-
-(test-equal "Handles 'and*' fall-through without default"
-  '()
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-and*> "x" #f)))))
-
-;;; length
-
-(test-equal "Handles 'length' when parameter is set"
-  '("3")
-  (with-variables '(("x" . "foo"))
-    (lambda ()
-      (expand-word '(<sh-ref-length> "x")))))
-
-(test-equal "Handles 'length' when parameter is unset"
-  '("0")
-  (with-variables '()
-    (lambda ()
-      (expand-word '(<sh-ref-length> "x")))))
-
-
-;;; Command substition.
-
-(test-equal "Resolves commands"
-  '("foo")
-  (parameterize ((eval-cmd-sub identity))
-    (expand-word '(<sh-cmd-sub> "foo"))))
-
-(test-equal "Splits command results"
-  '("foo" "bar")
-  (parameterize ((eval-cmd-sub identity))
-    (expand-word '(<sh-cmd-sub> "foo bar"))))
-
-(test-equal "Resolves quoted commands"
-  '("foo")
-  (parameterize ((eval-cmd-sub identity))
-    (expand-word '(<sh-quote> (<sh-cmd-sub> "foo")))))
-
-(test-equal "Ignores spaces in quoted commands"
-  '("foo bar")
-  (parameterize ((eval-cmd-sub identity))
-    (expand-word '(<sh-quote> (<sh-cmd-sub> "foo bar")))))
-
-
-;;; Arithmetic expansion.
-;;;
-;;; Not yet implemented.
-
 
 ;;; Pathname expansion.
 
@@ -465,86 +194,86 @@ variable @var{PWD} will be restored when leaving the extent of
   '("a" "b" "c")
   (with-mocked-files '("" ("foo" "a" "b" "c"))
     (setvar! "PWD" "/foo")
-    (expand-word "*")))
+    (expand-qword "*")))
 
 (test-equal "Sorts expanded pathnames"
   '("a" "b" "c")
   (with-mocked-files '("" ("foo" "c" "b" "a"))
     (setvar! "PWD" "/foo")
-    (expand-word "*")))
+    (expand-qword "*")))
 
 (test-equal "Expands absolute pathnamess"
   '("/foo/a" "/foo/b")
   (with-mocked-files '("" ("foo" "a" "b"))
     (setvar! "PWD" "/")
-    (expand-word "/foo/*")))
+    (expand-qword "/foo/*")))
 
 (test-equal "Paths with trailing slashes get expanded"
   '("foo/")
   (with-mocked-files '("" ("foo" "bar") "baz")
     (setvar! "PWD" "/")
-    (expand-word "*/")))
+    (expand-qword "*/")))
 
 (test-equal "Expands patterns in the middle of a path"
   '("/bar/a" "/foo/a")
   (with-mocked-files '("" ("bar" "a") ("foo" "a"))
     (setvar! "PWD" "/")
-    (expand-word "/*/a")))
+    (expand-qword "/*/a")))
 
 (test-equal "Does not expand quoted patterns"
   '("*")
   (with-mocked-files '("" ("foo" "a" "b" "c"))
     (setvar! "PWD" "/foo")
-    (expand-word '(<sh-quote> "*"))))
+    (expand-qword '(<sh-quote> "*"))))
 
 (test-equal "Pathname expansion works when slashes are quoted"
   '("foo/bar")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/")
-    (expand-word '("foo" (<sh-quote> "/") "*"))))
+    (expand-qword '("foo" (<sh-quote> "/") "*"))))
 
 (test-equal "Pathname expansion works when slashes are patterns"
   '("f[o/b]r")
   (with-mocked-files '("" ("f[o" "b]r"))
     (setvar! "PWD" "/")
-    (expand-word "f[o/b]*")))
+    (expand-qword "f[o/b]*")))
 
 (test-equal "Pathname expansion works when slashes are broken patterns"
   '("f[o/bar")
   (with-mocked-files '("" ("f[o" "bar"))
     (setvar! "PWD" "/")
-    (expand-word "f[o/*")))
+    (expand-qword "f[o/*")))
 
 (test-equal "Does not implicitly match dotted files"
   '("baz")
   (with-mocked-files '("" ("foo" ".bar" "baz"))
     (setvar! "PWD" "/foo")
-    (expand-word "*")))
+    (expand-qword "*")))
 
 (test-equal "Explicitly matches dotted files"
   '("." ".." ".bar")
   (with-mocked-files '("" ("foo" ".bar" "baz"))
     (setvar! "PWD" "/foo")
-    (expand-word ".*")))
+    (expand-qword ".*")))
 
 ;; This is left unspecified in POSIX, so we follow Bash.
 (test-equal "Bracked dots are not explicit enough"
   '("[.]*")
   (with-mocked-files '("" ("foo" ".bar" "baz"))
     (setvar! "PWD" "/foo")
-    (expand-word "[.]*")))
+    (expand-qword "[.]*")))
 
 (test-equal "Paths with duplicate slashes get expanded"
   '("foo///bar")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/")
-    (expand-word "foo///*")))
+    (expand-qword "foo///*")))
 
 (test-equal "Absolute paths with duplicate slashes get expanded"
   '("///foo/bar")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/")
-    (expand-word "///foo/*")))
+    (expand-qword "///foo/*")))
 
 ;; Bash does not preserve the duplicate slashes, but Dash does, and it
 ;; seems like the more consistent thing to do.
@@ -552,25 +281,25 @@ variable @var{PWD} will be restored when leaving the extent of
   '("foo///")
   (with-mocked-files '("" ("foo" "bar") "baz")
     (setvar! "PWD" "/")
-    (expand-word "*///")))
+    (expand-qword "*///")))
 
 (test-equal "Paths with dot nodes get expanded"
   '("./foo/./bar")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/")
-    (expand-word "./foo/./*")))
+    (expand-qword "./foo/./*")))
 
 (test-equal "Paths with dot-dot nodes get expanded"
   '("../foo/../foo/bar")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/foo")
-    (expand-word "../*/../*/*")))
+    (expand-qword "../*/../*/*")))
 
 (test-equal "Patterns matching dot-dot get expanded"
   '("../foo")
   (with-mocked-files '("" ("foo" "bar"))
     (setvar! "PWD" "/foo")
-    (expand-word ".*/f*")))
+    (expand-qword ".*/f*")))
 
 
 ;;; Field splitting (IFS)
@@ -579,49 +308,49 @@ variable @var{PWD} will be restored when leaving the extent of
   '("foo" "bar")
   (with-variables '(("IFS" . "-"))
     (lambda ()
-      (expand-word '("foo-bar")))))
+      (expand-qword '("foo-bar")))))
 
 (test-equal "Combines multiple whitespace separators"
   '("foo" "bar")
   (with-variables '(("IFS" . " "))
     (lambda ()
-      (expand-word '("foo  bar")))))
+      (expand-qword '("foo  bar")))))
 
 (test-equal "Keeps multiple non-whitespace separators"
   '("foo" "" "bar")
   (with-variables '(("IFS" . "-"))
     (lambda ()
-      (expand-word '("foo--bar")))))
+      (expand-qword '("foo--bar")))))
 
 (test-equal "Combines whitespace separators with a non-whitespace separator"
   '("foo" "bar")
   (with-variables '(("IFS" . "- "))
     (lambda ()
-      (expand-word '("foo - bar")))))
+      (expand-qword '("foo - bar")))))
 
 (test-equal "Keeps multiple non-whitespace separators with whitespace"
   '("foo" "" "bar")
   (with-variables '(("IFS" . "- "))
     (lambda ()
-      (expand-word '("foo - - bar")))))
+      (expand-qword '("foo - - bar")))))
 
 (test-equal "Splits on leading non-whitespace separator"
   '("" "foo")
   (with-variables '(("IFS" . "-"))
     (lambda ()
-      (expand-word '("-foo")))))
+      (expand-qword '("-foo")))))
 
 (test-equal "Does not split on trailing non-whitespace separator"
   '("foo")
   (with-variables '(("IFS" . "-"))
     (lambda ()
-      (expand-word '("foo-")))))
+      (expand-qword '("foo-")))))
 
 (test-equal "Makes one field for single non-whitespace separator"
   '("")
   (with-variables '(("IFS" . "-"))
     (lambda ()
-      (expand-word '("-")))))
+      (expand-qword '("-")))))
 
 (test-end)