Move evaluation code from 'word' to 'eval'.
This adjustment paves the way for writing a compiler. * gash/word.scm (eval-cmd-sub, string-not-null?, word->qword, expand-word): Move these... * gash/eval.scm: ...to this module. * tests/unit/word.scm: Adjust qword tests to use 'expand-qword', and move non-qword (evaluation) tests to... * tests/unit/eval.scm: ...this new file, adjusting them to use 'eval-word'. * Makefile.am (UNIT_TESTS): Add the new file.
This commit is contained in:
Timothy Sample
parent
2bce1ea07b
commit
d3244e0ec0
|
|
@ -143,6 +143,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 \
|
||||
|
|
|
|||
|
|
@ -20,12 +20,14 @@
|
|||
(define-module (gash eval)
|
||||
#: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 +35,86 @@
|
|||
;;;
|
||||
;;; 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-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)
|
||||
|
|
|
|||
|
|
@ -23,9 +23,8 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (eval-cmd-sub
|
||||
expand-qword
|
||||
expand-word))
|
||||
#:export (parameter-ref
|
||||
expand-qword))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -237,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
|
||||
|
|
@ -269,74 +259,6 @@ 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-qword qword #:key (output 'fields) (rhs-tildes? #f))
|
||||
"Expand @var{qword} into a list of fields."
|
||||
(let ((ifs (getvar "IFS" (string #\space #\tab #\newline)))
|
||||
|
|
@ -349,8 +271,3 @@ and arithmetic substitions."
|
|||
(split-fields qword ifs))))
|
||||
('string (remove-quotes qword ifs))
|
||||
('pattern (qword->pattern qword ifs)))))
|
||||
|
||||
(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?)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,300 @@
|
|||
;;; 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 (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.
|
||||
;;;
|
||||
;;; Not yet implemented.
|
||||
|
||||
(test-end "eval")
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue