diff --git a/Makefile.am b/Makefile.am index 7987881..431fe9a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/gash/eval.scm b/gash/eval.scm index 61b1ccc..576e6cc 100644 --- a/gash/eval.scm +++ b/gash/eval.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) + ((' quoted-word) + `( ,(word->qword quoted-word))) + ((' . exps) + ((eval-cmd-sub) exps)) + ((' name) + (parameter-ref name "")) + ((' name default) + (or (parameter-ref name) + (word->qword (or default "")))) + ((' name default) + (let ((value (parameter-ref name))) + (if (string-not-null? value) + value + (word->qword (or default ""))))) + ((' name default) + (or (parameter-ref name) + (let ((new-value (expand-word (or default "") + #:output 'string #:rhs-tildes? #t))) + (setvar! name new-value) + new-value))) + ((' 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)))) + ((' name message) + (or (parameter-ref name) + (let ((message* (expand-word message #:output 'string))) + (throw 'shell-error (format #f "~a: ~a" name message*))))) + ((' 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*)))))) + ((' name value) + (or (and (parameter-ref name) + (word->qword (or value ""))) + "")) + ((' name value) + (if (string-not-null? (parameter-ref name)) + (word->qword (or value "")) + "")) + ((' name pattern-word) + (let ((pattern (expand-word pattern-word #:output 'pattern))) + (pattern-drop-right pattern (parameter-ref name "")))) + ((' name pattern-word) + (let ((pattern (expand-word pattern-word #:output 'pattern))) + (pattern-drop-right pattern (parameter-ref name "") #:greedy? #t))) + ((' name pattern-word) + (let ((pattern (expand-word pattern-word #:output 'pattern))) + (pattern-drop pattern (parameter-ref name "")))) + ((' name pattern-word) + (let ((pattern (expand-word pattern-word #:output 'pattern))) + (pattern-drop pattern (parameter-ref name "") #:greedy? #t))) + ((' 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) diff --git a/gash/word.scm b/gash/word.scm index 2bac8d5..3dbe9fc 100644 --- a/gash/word.scm +++ b/gash/word.scm @@ -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) - ((' quoted-word) - `( ,(word->qword quoted-word))) - ((' . exps) - ((eval-cmd-sub) exps)) - ((' name) - (parameter-ref name "")) - ((' name default) - (or (parameter-ref name) - (word->qword (or default "")))) - ((' name default) - (let ((value (parameter-ref name))) - (if (string-not-null? value) - value - (word->qword (or default ""))))) - ((' name default) - (or (parameter-ref name) - (let ((new-value (expand-word (or default "") - #:output 'string #:rhs-tildes? #t))) - (setvar! name new-value) - new-value))) - ((' 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)))) - ((' name message) - (or (parameter-ref name) - (let ((message* (expand-word message #:output 'string))) - (throw 'shell-error (format #f "~a: ~a" name message*))))) - ((' 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*)))))) - ((' name value) - (or (and (parameter-ref name) - (word->qword (or value ""))) - "")) - ((' name value) - (if (string-not-null? (parameter-ref name)) - (word->qword (or value "")) - "")) - ((' name pattern-word) - (let ((pattern (expand-word pattern-word #:output 'pattern))) - (pattern-drop-right pattern (parameter-ref name "")))) - ((' name pattern-word) - (let ((pattern (expand-word pattern-word #:output 'pattern))) - (pattern-drop-right pattern (parameter-ref name "") #:greedy? #t))) - ((' name pattern-word) - (let ((pattern (expand-word pattern-word #:output 'pattern))) - (pattern-drop pattern (parameter-ref name "")))) - ((' name pattern-word) - (let ((pattern (expand-word pattern-word #:output 'pattern))) - (pattern-drop pattern (parameter-ref name "") #:greedy? #t))) - ((' 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?))) diff --git a/tests/unit/eval.scm b/tests/unit/eval.scm new file mode 100644 index 0000000..877d466 --- /dev/null +++ b/tests/unit/eval.scm @@ -0,0 +1,300 @@ +;;; Gash -- Guile As SHell +;;; Copyright © 2018, 2019, 2021 Timothy Sample +;;; +;;; 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 . + +(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 '( "x"))))) + +(test-equal "Splits parameter results" + '("foo" "bar") + (with-variables '(("x" . "foo bar")) + (lambda () + (eval-word '( "x"))))) + +(test-equal "Resolves quoted parameters" + '("foo") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( ( "x")))))) + +(test-equal "Ignores spaces in quoted parameters" + '("foo bar") + (with-variables '(("x" . "foo bar")) + (lambda () + (eval-word '( ( "x")))))) + +(test-equal "Treats empty variables as nothing" + '() + (with-variables '(("x" . "")) + (lambda () + (eval-word '( "x"))))) + +(test-equal "Treats unset variables as nothing" + '() + (with-variables '() + (lambda () + (eval-word '( "x"))))) + +(test-equal "Preserves empty variables when quoted" + '("") + (with-variables '(("x" . "")) + (lambda () + (eval-word '( ( "x")))))) + +(test-equal "Preserves unset variables when quoted" + '("") + (with-variables '() + (lambda () + (eval-word '( ( "x")))))) + + +;;; Parameter operations. + +;;; or + +(test-equal "Handles 'or' when parameter is set" + '("foo") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or' when parameter is set and empty" + '() + (with-variables '(("x" . "")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or' when parameter is unset" + '("bar") + (with-variables '() + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or' fall-through without default" + '() + (with-variables '() + (lambda () + (eval-word '( "x" #f))))) + +;;; or* + +(test-equal "Handles 'or*' when parameter is set" + '("foo") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or*' when parameter is set and empty" + '("bar") + (with-variables '(("x" . "")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or*' when parameter is unset" + '("bar") + (with-variables '() + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'or*' fall-through without default" + '() + (with-variables '() + (lambda () + (eval-word '( "x" #f))))) + +;;; or! + +(test-equal "Handles 'or!' when parameter is set" + '(("foo") "foo") + (with-variables '(("x" . "foo")) + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!' when parameter is set and empty" + '(() "") + (with-variables '(("x" . "")) + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!' when parameter is unset" + '(("bar") "bar") + (with-variables '() + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!' fall-through without default" + '(() "") + (with-variables '() + (lambda () + (list (eval-word '( "x" #f)) + (getvar "x"))))) + +;;; or!* + +(test-equal "Handles 'or!*' when parameter is set" + '(("foo") "foo") + (with-variables '(("x" . "foo")) + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!*' when parameter is set and empty" + '(("bar") "bar") + (with-variables '(("x" . "")) + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!*' when parameter is unset" + '(("bar") "bar") + (with-variables '() + (lambda () + (list (eval-word '( "x" "bar")) + (getvar "x"))))) + +(test-equal "Handles 'or!*' fall-through without default" + '(() "") + (with-variables '() + (lambda () + (list (eval-word '( "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 '( "x" ( "y"))) + (getvar "x"))))) + +;;; FIXME: Test 'assert'. + +;;; and + +(test-equal "Handles 'and' when parameter is set" + '("bar") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and' when parameter is set and empty" + '("bar") + (with-variables '(("x" . "")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and' when parameter is unset" + '() + (with-variables '() + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and' fall-through without default" + '() + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" #f))))) + +;;; and* + +(test-equal "Handles 'and*' when parameter is set" + '("bar") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and*' when parameter is set and empty" + '() + (with-variables '(("x" . "")) + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and*' when parameter is unset" + '() + (with-variables '() + (lambda () + (eval-word '( "x" "bar"))))) + +(test-equal "Handles 'and*' fall-through without default" + '() + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x" #f))))) + +;;; length + +(test-equal "Handles 'length' when parameter is set" + '("3") + (with-variables '(("x" . "foo")) + (lambda () + (eval-word '( "x"))))) + +(test-equal "Handles 'length' when parameter is unset" + '("0") + (with-variables '() + (lambda () + (eval-word '( "x"))))) + + +;;; Command substition. + +(test-equal "Resolves commands" + '("foo") + (eval-word '( ( "echo" "foo")))) + +(test-equal "Splits command results" + '("foo" "bar") + (eval-word '( ( "echo" "foo bar")))) + +(test-equal "Resolves quoted commands" + '("foo") + (eval-word '( ( ( "echo" "foo"))))) + +(test-equal "Ignores spaces in quoted commands" + '("foo bar") + (eval-word '( ( ( "echo" "foo bar"))))) + + +;;; Arithmetic expansion. +;;; +;;; Not yet implemented. + +(test-end "eval") diff --git a/tests/unit/word.scm b/tests/unit/word.scm index 4e9dd84..8e6e4b4 100644 --- a/tests/unit/word.scm +++ b/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 '( "foo bar"))) + (expand-qword '( "foo bar"))) (test-equal "Concatenates strings and quotes" '("foo bar") - (expand-word '("foo" ( " bar")))) + (expand-qword '("foo" ( " bar")))) (test-equal "Concatenates quotes" '("foo bar") - (expand-word '(( "foo") ( " bar")))) + (expand-qword '(( "foo") ( " bar")))) (test-equal "Handles nested quotes" '("foo bar") - (expand-word '( ( "foo bar")))) + (expand-qword '( ( "foo bar")))) (test-equal "Splits and concatenates words and quotes" '("foo" "bar") - (expand-word '(( "foo") " " ( "bar")))) + (expand-qword '(( "foo") " " ( "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 '( "x"))))) - -(test-equal "Splits parameter results" - '("foo" "bar") - (with-variables '(("x" . "foo bar")) - (lambda () - (expand-word '( "x"))))) - -(test-equal "Resolves quoted parameters" - '("foo") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( ( "x")))))) - -(test-equal "Ignores spaces in quoted parameters" - '("foo bar") - (with-variables '(("x" . "foo bar")) - (lambda () - (expand-word '( ( "x")))))) - -(test-equal "Treats empty variables as nothing" - '() - (with-variables '(("x" . "")) - (lambda () - (expand-word '( "x"))))) - -(test-equal "Treats unset variables as nothing" - '() - (with-variables '() - (lambda () - (expand-word '( "x"))))) - -(test-equal "Preserves empty variables when quoted" - '("") - (with-variables '(("x" . "")) - (lambda () - (expand-word '( ( "x")))))) - -(test-equal "Preserves unset variables when quoted" - '("") - (with-variables '() - (lambda () - (expand-word '( ( "x")))))) - - -;;; Parameter operations. - -;;; or - -(test-equal "Handles 'or' when parameter is set" - '("foo") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or' when parameter is set and empty" - '() - (with-variables '(("x" . "")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or' when parameter is unset" - '("bar") - (with-variables '() - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or' fall-through without default" - '() - (with-variables '() - (lambda () - (expand-word '( "x" #f))))) - -;;; or* - -(test-equal "Handles 'or*' when parameter is set" - '("foo") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or*' when parameter is set and empty" - '("bar") - (with-variables '(("x" . "")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or*' when parameter is unset" - '("bar") - (with-variables '() - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'or*' fall-through without default" - '() - (with-variables '() - (lambda () - (expand-word '( "x" #f))))) - -;;; or! - -(test-equal "Handles 'or!' when parameter is set" - '(("foo") "foo") - (with-variables '(("x" . "foo")) - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!' when parameter is set and empty" - '(() "") - (with-variables '(("x" . "")) - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!' when parameter is unset" - '(("bar") "bar") - (with-variables '() - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!' fall-through without default" - '(() "") - (with-variables '() - (lambda () - (list (expand-word '( "x" #f)) - (getvar "x"))))) - -;;; or!* - -(test-equal "Handles 'or!*' when parameter is set" - '(("foo") "foo") - (with-variables '(("x" . "foo")) - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!*' when parameter is set and empty" - '(("bar") "bar") - (with-variables '(("x" . "")) - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!*' when parameter is unset" - '(("bar") "bar") - (with-variables '() - (lambda () - (list (expand-word '( "x" "bar")) - (getvar "x"))))) - -(test-equal "Handles 'or!*' fall-through without default" - '(() "") - (with-variables '() - (lambda () - (list (expand-word '( "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 '( "x" ( "y"))) - (getvar "x"))))) - -;;; FIXME: Test 'assert'. - -;;; and - -(test-equal "Handles 'and' when parameter is set" - '("bar") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and' when parameter is set and empty" - '("bar") - (with-variables '(("x" . "")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and' when parameter is unset" - '() - (with-variables '() - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and' fall-through without default" - '() - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" #f))))) - -;;; and* - -(test-equal "Handles 'and*' when parameter is set" - '("bar") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and*' when parameter is set and empty" - '() - (with-variables '(("x" . "")) - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and*' when parameter is unset" - '() - (with-variables '() - (lambda () - (expand-word '( "x" "bar"))))) - -(test-equal "Handles 'and*' fall-through without default" - '() - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x" #f))))) - -;;; length - -(test-equal "Handles 'length' when parameter is set" - '("3") - (with-variables '(("x" . "foo")) - (lambda () - (expand-word '( "x"))))) - -(test-equal "Handles 'length' when parameter is unset" - '("0") - (with-variables '() - (lambda () - (expand-word '( "x"))))) - - -;;; Command substition. - -(test-equal "Resolves commands" - '("foo") - (parameterize ((eval-cmd-sub identity)) - (expand-word '( "foo")))) - -(test-equal "Splits command results" - '("foo" "bar") - (parameterize ((eval-cmd-sub identity)) - (expand-word '( "foo bar")))) - -(test-equal "Resolves quoted commands" - '("foo") - (parameterize ((eval-cmd-sub identity)) - (expand-word '( ( "foo"))))) - -(test-equal "Ignores spaces in quoted commands" - '("foo bar") - (parameterize ((eval-cmd-sub identity)) - (expand-word '( ( "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 '( "*")))) + (expand-qword '( "*")))) (test-equal "Pathname expansion works when slashes are quoted" '("foo/bar") (with-mocked-files '("" ("foo" "bar")) (setvar! "PWD" "/") - (expand-word '("foo" ( "/") "*")))) + (expand-qword '("foo" ( "/") "*")))) (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)