Compare commits
82 Commits
Author | SHA1 | Date |
---|---|---|
Timothy Sample | a3123ab02a | |
Timothy Sample | ec009a89bb | |
Timothy Sample | d0d90d0956 | |
Timothy Sample | eae0953f31 | |
Timothy Sample | 57d21182e2 | |
Timothy Sample | 87229e4b3a | |
Timothy Sample | d3244e0ec0 | |
Timothy Sample | 2bce1ea07b | |
Timothy Sample | 1e88c314d6 | |
Timothy Sample | 18ecd7d142 | |
Timothy Sample | 1e752e54bf | |
Timothy Sample | 9f9a866b19 | |
Stephen J. Scheck | 8f9b973264 | |
Timothy Sample | 8cbb4803c8 | |
Timothy Sample | f22bc57996 | |
Timothy Sample | 01204cb807 | |
Timothy Sample | 855e15f928 | |
Timothy Sample | a0b6189cf3 | |
Timothy Sample | 82c45abed6 | |
Timothy Sample | 25cd5ac5af | |
Timothy Sample | b8c29ebe6c | |
Timothy Sample | 917cbf2aba | |
Timothy Sample | b2faf08ed4 | |
Timothy Sample | 9ba534ebff | |
Timothy Sample | de485819ca | |
Timothy Sample | b7c2153785 | |
Timothy Sample | 6f598de23a | |
Timothy Sample | 98b60c0d68 | |
Jan Nieuwenhuizen | 45223e7d86 | |
Timothy Sample | a4cfff0641 | |
Jan Nieuwenhuizen | fda97e32ef | |
Timothy Sample | 82b6769285 | |
Timothy Sample | f005b1acbc | |
Jan Nieuwenhuizen | 6f81266e2b | |
Timothy Sample | d905679e9a | |
Timothy Sample | 2d41b4ae5a | |
Timothy Sample | 4f90afcd3d | |
Timothy Sample | 8a440f35f6 | |
Timothy Sample | d600f82f7f | |
Jan Nieuwenhuizen | 7eacf52807 | |
Timothy Sample | 121d9cb435 | |
Timothy Sample | 22205a00a3 | |
Timothy Sample | 168f422955 | |
Timothy Sample | 3d3375e066 | |
Timothy Sample | 7687552149 | |
Timothy Sample | cf6a886f61 | |
Timothy Sample | 4acbd303a9 | |
Timothy Sample | 49ac5e74d3 | |
Timothy Sample | 66685b6219 | |
Timothy Sample | 7deaa94bd5 | |
Timothy Sample | 8135e19904 | |
Timothy Sample | 7fee72f5c7 | |
Timothy Sample | 9d98405821 | |
Timothy Sample | d6a582f1bd | |
Timothy Sample | 6990d656bc | |
Timothy Sample | 38001cb76d | |
Timothy Sample | 804b6cbe05 | |
Timothy Sample | 5fed1b0d87 | |
Timothy Sample | 7a0f4fbae2 | |
Timothy Sample | 16ba8ca016 | |
Timothy Sample | b41ae32106 | |
Timothy Sample | 3c7693ece6 | |
Timothy Sample | 5450e19094 | |
Timothy Sample | 1b41a34ce2 | |
Timothy Sample | 5a27fd59cc | |
Timothy Sample | 5c1602d5f2 | |
Timothy Sample | 223e8d2635 | |
Timothy Sample | e029c4cbab | |
Timothy Sample | 7c8ddd7a43 | |
Timothy Sample | a009118efb | |
Timothy Sample | dd215ee926 | |
Timothy Sample | 0b49934a0b | |
Timothy Sample | 9639f5eff7 | |
Timothy Sample | fdd835842a | |
Timothy Sample | d9122d7b68 | |
Timothy Sample | da9a05d500 | |
Timothy Sample | 6228064801 | |
Timothy Sample | 150c6eac53 | |
Timothy Sample | ffe9fc1f47 | |
Timothy Sample | 7d2298d15b | |
Timothy Sample | 375752301c | |
Timothy Sample | 945c54f8b2 |
|
@ -9,6 +9,7 @@
|
|||
!/build-aux/git-version-gen
|
||||
!/build-aux/gitlab-ci.yml
|
||||
!/build-aux/gitlog-to-changelog
|
||||
!/build-aux/gitlog-to-changelog-repro.patch
|
||||
!/build-aux/guile.am
|
||||
!/build-aux/pre-inst-env.in
|
||||
/config.log
|
||||
|
@ -22,8 +23,7 @@
|
|||
/lcov.info
|
||||
/pre-inst-env
|
||||
/scripts/gash
|
||||
/tests/*.1
|
||||
/tests/*.2
|
||||
/tests/run-test-suite
|
||||
/tests/spec/oil
|
||||
/tests/spec/oil-link
|
||||
/tests/unit/config.scm
|
||||
|
|
14
ChangeLog
14
ChangeLog
|
@ -1,4 +1,16 @@
|
|||
Normally a ChangeLog is generated at "make dist" time and available in
|
||||
source tarballs.
|
||||
|
||||
If not, see the Git commit log at <https://git.ngyro.com/gash>.
|
||||
If not, see the Git commit log:
|
||||
|
||||
<https://git.savannah.nongnu.org/cgit/gash.git/log/>.
|
||||
|
||||
The following notice will be appended to the generated ChangeLog.
|
||||
|
||||
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,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved. This file is offered as-is,
|
||||
without any warranty.
|
||||
|
|
319
Makefile.am
319
Makefile.am
|
@ -27,13 +27,15 @@ EXTRA_DIST += \
|
|||
build-aux/git-version-gen \
|
||||
build-aux/gitlab-ci.yml \
|
||||
build-aux/gitlog-to-changelog \
|
||||
build-aux/gitlog-to-changelog-repro.patch \
|
||||
guix.scm \
|
||||
tests/README
|
||||
tests/data/README
|
||||
|
||||
# Modules and scripts
|
||||
#####################
|
||||
|
||||
SOURCES = \
|
||||
gash/arithmetic.scm \
|
||||
gash/built-ins/break.scm \
|
||||
gash/built-ins/cd.scm \
|
||||
gash/built-ins/colon.scm \
|
||||
|
@ -58,8 +60,10 @@ 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 \
|
||||
gash/compat/textual-ports.scm \
|
||||
gash/compat.scm \
|
||||
gash/config.scm \
|
||||
|
@ -72,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
|
||||
|
@ -100,13 +105,31 @@ EXTRA_DIST += \
|
|||
$(gash_TEXINFOS) \
|
||||
doc/syntax.txt
|
||||
|
||||
# Generate 'version.texi' reproducibly using metadata from Git rather
|
||||
# than using metadata from the filesystem.
|
||||
override $(srcdir)/doc/version.texi:
|
||||
$(AM_V_GEN)set -e \
|
||||
LC_ALL=C; export LC_ALL; \
|
||||
TZ=UTC0; export TZ; \
|
||||
timestamp=$$(git log --pretty=format:%ct -- doc/gash.texi \
|
||||
| sort -n -r | head -n 1); \
|
||||
dmy=$$(date --date="@$$timestamp" "+%-d %B %Y"); \
|
||||
my=$$(date --date="@$$timestamp" "+%B %Y"); \
|
||||
{ echo "@set UPDATED $$dmy"; \
|
||||
echo "@set UPDATED-MONTH $$my"; \
|
||||
echo "@set EDITION $(VERSION)"; \
|
||||
echo "@set VERSION $(VERSION)"; } > $@-t; \
|
||||
mv $@-t $@
|
||||
|
||||
# Tests
|
||||
#######
|
||||
|
||||
TEST_EXTENSIONS = .scm .sh
|
||||
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
|
||||
SH_LOG_COMPILER = $(top_builddir)/pre-inst-env $(top_srcdir)/test.sh
|
||||
ORG_LOG_COMPILER = $(top_builddir)/pre-inst-env \
|
||||
$(top_builddir)/tests/run-test-suite
|
||||
|
||||
.PHONY: check-spec
|
||||
check-spec:
|
||||
|
@ -121,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 \
|
||||
|
@ -128,234 +152,47 @@ UNIT_TESTS = \
|
|||
tests/unit/word.scm
|
||||
|
||||
FULL_TESTS = \
|
||||
tests/00-exit.sh \
|
||||
tests/00-exit-0.sh \
|
||||
tests/00-exit-1.sh \
|
||||
tests/00-exit-2.sh \
|
||||
tests/00-exit-error.sh \
|
||||
tests/00-exit-var.sh \
|
||||
tests/01-script-newline.sh \
|
||||
tests/01-script-semi.sh \
|
||||
tests/01-script-backslash.sh \
|
||||
tests/01-script-backslash-space.sh \
|
||||
tests/01-script-backslash-twice.sh \
|
||||
tests/01-script-arg-0.sh \
|
||||
tests/01-script-arg-length.sh \
|
||||
tests/01-script-arg-list.sh \
|
||||
tests/01-script-shift.sh \
|
||||
tests/03-echo.sh \
|
||||
tests/03-echo-doublequotes.sh \
|
||||
tests/03-echo-nesting.sh \
|
||||
tests/03-echo-escaped-doublequotes.sh \
|
||||
tests/03-echo-quoted-doublequotes.sh \
|
||||
tests/03-echo-brace.sh \
|
||||
tests/04-echo-var.sh \
|
||||
tests/04-echo-equal.sh \
|
||||
tests/04-echo-word-at.sh \
|
||||
tests/04-echo-word-at-word.sh \
|
||||
tests/05-assignment.sh \
|
||||
tests/05-assignment-backtick.sh \
|
||||
tests/05-assignment-echo.sh \
|
||||
tests/05-assignment-empty.sh \
|
||||
tests/05-assignment-singlequote.sh \
|
||||
tests/05-assignment-double-quote.sh \
|
||||
tests/05-assignment-variable-word.sh \
|
||||
tests/05-assignment-word-variable.sh \
|
||||
tests/05-assignment-doublequoted-doublequotes.sh \
|
||||
tests/06-compound-word.sh \
|
||||
tests/06-command-compound-word.sh \
|
||||
tests/07-variable-or.sh \
|
||||
tests/07-variable-not-or.sh \
|
||||
tests/07-variable-or-slash.sh \
|
||||
tests/07-variable-or-variable.sh \
|
||||
tests/07-variable-or-doublequote.sh \
|
||||
tests/07-variable-or-empty.sh \
|
||||
tests/08-variable-and.sh \
|
||||
tests/08-variable-not-and.sh \
|
||||
tests/10-if.sh \
|
||||
tests/10-if-false.sh \
|
||||
tests/10-if-word-variable.sh \
|
||||
tests/10-if-line.sh \
|
||||
tests/10-if-multiple.sh \
|
||||
tests/10-if-else.sh \
|
||||
tests/10-else-multiple.sh \
|
||||
tests/10-if-elif.sh \
|
||||
tests/10-if-redirect.sh \
|
||||
tests/10-if-test.sh \
|
||||
tests/10-if-test-false.sh \
|
||||
tests/10-if-bracket.sh \
|
||||
tests/10-if-bracket-false.sh \
|
||||
tests/11-for.sh \
|
||||
tests/11-for-split-sequence.sh \
|
||||
tests/11-for-done-subshell.sh \
|
||||
tests/20-semi.sh \
|
||||
tests/20-or.sh \
|
||||
tests/20-and.sh \
|
||||
tests/20-pipe-exit-0.sh \
|
||||
tests/20-pipe-exit-1.sh \
|
||||
tests/20-pipe-sed.sh \
|
||||
tests/20-pipe-sed-cat.sh \
|
||||
tests/20-exec.sh \
|
||||
tests/30-substitution.sh \
|
||||
tests/30-substitution-word.sh \
|
||||
tests/30-substitution-backtick.sh \
|
||||
tests/30-substitution-assignment.sh \
|
||||
tests/30-for-substitution.sh \
|
||||
tests/30-substitution-assignment.sh \
|
||||
tests/30-substitution-assignment-at.sh \
|
||||
tests/30-substitution-redirect.sh \
|
||||
tests/40-eval.sh \
|
||||
tests/40-eval-echo-variable.sh \
|
||||
tests/40-assignment-eval-echo.sh \
|
||||
tests/41-dot.sh \
|
||||
tests/42-sh.sh \
|
||||
tests/42-sh-export.sh \
|
||||
tests/42-export-new.sh \
|
||||
tests/42-sh-export-new.sh \
|
||||
tests/43-trap-subshell.sh \
|
||||
tests/50-iohere.sh \
|
||||
tests/50-iohere-builtin.sh \
|
||||
tests/50-redirect.sh \
|
||||
tests/50-redirect-in.sh \
|
||||
tests/50-redirect-append.sh \
|
||||
tests/50-redirect-pipe.sh \
|
||||
tests/50-redirect-sed.sh \
|
||||
tests/50-redirect-space.sh \
|
||||
tests/50-redirect-in-out.sh \
|
||||
tests/50-redirect-clobber.sh \
|
||||
tests/60-function.sh \
|
||||
tests/60-function-at.sh \
|
||||
tests/60-subst.sh \
|
||||
tests/70-hash.sh \
|
||||
tests/70-hash-hash.sh \
|
||||
tests/70-percent.sh \
|
||||
tests/70-percent-percent.sh \
|
||||
tests/70-percent-space.sh \
|
||||
tests/70-slash.sh \
|
||||
tests/70-slash-string.sh \
|
||||
tests/70-slash-string-slash.sh \
|
||||
tests/100-cd.sh \
|
||||
tests/100-cd-foo.sh \
|
||||
tests/100-test.sh \
|
||||
tests/100-test-false.sh \
|
||||
tests/100-test-file.sh \
|
||||
tests/100-bracket-file.sh
|
||||
tests/arguments.org \
|
||||
tests/assignments.org \
|
||||
tests/command-substitution.org \
|
||||
tests/compound-words.org \
|
||||
tests/conditionals.org \
|
||||
tests/dot.org \
|
||||
tests/eval.org \
|
||||
tests/exiting.org \
|
||||
tests/exporting.org \
|
||||
tests/functions.org \
|
||||
tests/loops.org \
|
||||
tests/pipes-and-booleans.org \
|
||||
tests/read.org \
|
||||
tests/redirects.org \
|
||||
tests/signals.org \
|
||||
tests/temporary-assignments.org \
|
||||
tests/variable-and.org \
|
||||
tests/variable-operators.org \
|
||||
tests/variable-or.org \
|
||||
tests/variable-patterns.org \
|
||||
tests/variable-words.org \
|
||||
tests/words.org
|
||||
|
||||
TESTS = $(UNIT_TESTS) $(FULL_TESTS)
|
||||
|
||||
XFAIL_TESTS = \
|
||||
tests/70-hash.sh \
|
||||
tests/70-hash-hash.sh \
|
||||
tests/70-percent.sh \
|
||||
tests/70-percent-percent.sh \
|
||||
tests/70-percent-space.sh \
|
||||
tests/70-slash.sh \
|
||||
tests/70-slash-string.sh \
|
||||
tests/70-slash-string-slash.sh
|
||||
|
||||
# These tests will not be run. Put tests here
|
||||
# that pass or fail based on environmental
|
||||
# factors.
|
||||
BROKEN_TESTS = \
|
||||
tests/50-redirect-merge.sh
|
||||
|
||||
TEST_DATA_FILES = \
|
||||
tests/00-exit-1.exit \
|
||||
tests/00-exit-2.exit \
|
||||
tests/00-exit-error.exit \
|
||||
tests/00-exit-var.exit \
|
||||
tests/01-script-arg-length.stdout \
|
||||
tests/01-script-arg-list.stdout \
|
||||
tests/01-script-backslash-twice.exit \
|
||||
tests/01-script-backslash.exit \
|
||||
tests/01-script-newline.exit \
|
||||
tests/01-script-semi.exit \
|
||||
tests/01-script-shift.stdout \
|
||||
tests/03-echo-brace.stdout \
|
||||
tests/03-echo-doublequotes.stdout \
|
||||
tests/03-echo-escaped-doublequotes.stdout \
|
||||
tests/03-echo-nesting.stdout \
|
||||
tests/03-echo-quoted-doublequotes.stdout \
|
||||
tests/04-echo-equal.stdout \
|
||||
tests/04-echo-word-at-word.stdout \
|
||||
tests/04-echo-word-at.stdout \
|
||||
tests/05-assignment-backtick.stdout \
|
||||
tests/05-assignment-doublequoted-doublequotes.stdout \
|
||||
tests/05-assignment-echo.stdout \
|
||||
tests/05-assignment-empty.stdout \
|
||||
tests/05-assignment-variable-word.stdout \
|
||||
tests/05-assignment-word-variable.stdout \
|
||||
tests/06-command-compound-word.stdout \
|
||||
tests/06-compound-word.stdout \
|
||||
tests/07-variable-not-or.stdout \
|
||||
tests/07-variable-or-doublequote.stdout \
|
||||
tests/07-variable-or-empty.stdout \
|
||||
tests/07-variable-or-variable.stdout \
|
||||
tests/07-variable-or.stdout \
|
||||
tests/08-variable-and.stdout \
|
||||
tests/08-variable-not-and.stdout \
|
||||
tests/10-else.multiple.stdout \
|
||||
tests/10-if-multiple.stdout \
|
||||
tests/11-for-done-subshell.stdout \
|
||||
tests/11-for-split-sequence.stdout \
|
||||
tests/11-for.stdout \
|
||||
tests/20-and.exit \
|
||||
tests/20-pipe-exit-1.exit \
|
||||
tests/20-pipe-sed-cat.stdout \
|
||||
tests/20-pipe-sed.stdout \
|
||||
tests/20-semi.exit \
|
||||
tests/30-for-substitution.stdout \
|
||||
tests/30-substitution-assignment-at.stdout \
|
||||
tests/30-substitution-assignment.stdout \
|
||||
tests/30-substitution-backtick.stdout \
|
||||
tests/30-substitution-redirect.stdout \
|
||||
tests/30-substitution-word.stdout \
|
||||
tests/30-substitution.stdout \
|
||||
tests/40-assignment-eval-echo.stdout \
|
||||
tests/40-eval-echo-variable.stdout \
|
||||
tests/40-eval.stdout \
|
||||
tests/41-dot.stdout \
|
||||
tests/42-export-new.stdout \
|
||||
tests/42-sh-export-new.stdout \
|
||||
tests/42-sh-export.stdout \
|
||||
tests/42-sh.stdout \
|
||||
tests/43-trap-subshell.stdout \
|
||||
tests/50-iohere.stdout \
|
||||
tests/50-redirect-append.stdout \
|
||||
tests/50-redirect-clobber.stdout \
|
||||
tests/50-redirect-in-out.stdout \
|
||||
tests/50-redirect-merge.stdout \
|
||||
tests/50-redirect-pipe.stdout \
|
||||
tests/50-redirect-sed.stdout \
|
||||
tests/50-redirect-space.stdout \
|
||||
tests/50-redirect.stdout \
|
||||
tests/60-function-at.stdout \
|
||||
tests/60-function.stdout \
|
||||
tests/70-hash-hash.stdout \
|
||||
tests/70-hash.stdout \
|
||||
tests/70-percent-percent.stdout \
|
||||
tests/70-percent-space.stdout \
|
||||
tests/70-percent.stdout \
|
||||
tests/70-slash-string.stdout \
|
||||
tests/70-slash.stdout \
|
||||
tests/100-cd-foo.exit \
|
||||
tests/100-cd.stdout \
|
||||
tests/data/star/2 \
|
||||
tests/data/star/3 \
|
||||
tests/data/star/0 \
|
||||
tests/data/star/1 \
|
||||
tests/data/foo \
|
||||
tests/data/diff.scm \
|
||||
tests/data/script.sh
|
||||
tests/data/script.sh \
|
||||
tests/data/42-export-new.sh
|
||||
|
||||
.PHONY: test-list
|
||||
test-list: ; @echo $(TESTS)
|
||||
|
||||
EXTRA_DIST += \
|
||||
$(TESTS) \
|
||||
$(BROKEN_TESTS) \
|
||||
$(TEST_DATA_FILES) \
|
||||
test.sh \
|
||||
tests/unit/automake.scm \
|
||||
tests/spec/check-spec \
|
||||
tests/spec/Makefile.am \
|
||||
|
@ -381,18 +218,42 @@ endif # HAVE_GENHTML
|
|||
|
||||
dist-hook: gen-ChangeLog
|
||||
echo $(VERSION) > $(distdir)/.tarball-version
|
||||
git ls-tree -r --name-only HEAD > $(distdir)/.tarball-manifest
|
||||
if test -e .git; then \
|
||||
git ls-tree -r --name-only HEAD \
|
||||
> $(distdir)/.tarball-manifest; \
|
||||
git show HEAD --format=%ct --no-patch 2>/dev/null \
|
||||
> $(distdir)/.tarball-timestamp; \
|
||||
else \
|
||||
cp $(srcdir)/.tarball-manifest $(distdir)/.tarball-manifest; \
|
||||
cp $(srcdir)/.tarball-timestamp $(distdir)/.tarball-timestamp; \
|
||||
fi
|
||||
|
||||
build-aux/gitlog-to-changelog-repro: \
|
||||
$(srcdir)/build-aux/gitlog-to-changelog \
|
||||
$(srcdir)/build-aux/gitlog-to-changelog-repro.patch
|
||||
$(AM_V_GEN){ mkdir -p $$(dirname $@) && \
|
||||
patch -t --output=$@ $? && \
|
||||
chmod a+x $@; }
|
||||
|
||||
.PHONY: gen-ChangeLog
|
||||
gen-ChangeLog:
|
||||
echo "This is the first release, so there are no changes yet!" \
|
||||
> $(distdir)/ChangeLog-t
|
||||
# Once we release a first version we can generate the ChangeLog from
|
||||
# Git and have it only include changes since the first release.
|
||||
# $(top_srcdir)/build-aux/gitlog-to-changelog \
|
||||
# > $(distdir)/ChangeLog-t
|
||||
rm -f $(distdir)/ChangeLog
|
||||
mv $(distdir)/ChangeLog-t $(distdir)/ChangeLog
|
||||
gen-ChangeLog: build-aux/gitlog-to-changelog-repro
|
||||
$(AM_V_GEN)if test -e .git; then \
|
||||
{ ./build-aux/gitlog-to-changelog-repro \
|
||||
--format='%s%n%n%b%n' -- v0.1.. && \
|
||||
echo && \
|
||||
sed -n -e '/^Copyright/,$$p' < $(top_srcdir)/ChangeLog; \
|
||||
} > $(distdir)/ChangeLog-t && \
|
||||
{ rm -f $(distdir)/ChangeLog && \
|
||||
mv $(distdir)/ChangeLog-t $(distdir)/ChangeLog; } \
|
||||
fi
|
||||
|
||||
# Reproducible tarball
|
||||
# Be friendly to Debian; avoid using EPOCH
|
||||
override GZIP_ENV = "--best --no-name"
|
||||
am__tar = $${TAR-tar} -chof - --sort=name \
|
||||
--mtime=@$$(cat "$$tardir"/.tarball-timestamp) \
|
||||
--owner=0 --group=0 --numeric-owner \
|
||||
--mode=go=rX,u+rw,a-s "$$tardir"
|
||||
|
||||
distcheck-hook:
|
||||
set -e; \
|
||||
|
@ -413,13 +274,13 @@ distcheck-hook:
|
|||
|
||||
CLEANFILES += \
|
||||
$(bin_SCRIPTS) \
|
||||
$(FULL_TESTS:tests/%.sh=tests/%.log) \
|
||||
$(FULL_TESTS:tests/%.sh=tests/%.trs) \
|
||||
$(FULL_TESTS:tests/%.sh=tests/%.1) \
|
||||
$(FULL_TESTS:tests/%.sh=tests/%.2) \
|
||||
$(FULL_TESTS:tests/%.org=tests/%.log) \
|
||||
$(FULL_TESTS:tests/%.org=tests/%.trs) \
|
||||
$(UNIT_TESTS:tests/%.scm=tests/%.log) \
|
||||
$(UNIT_TESTS:tests/%.scm=tests/%.trs)
|
||||
|
||||
DISTCLEANFILES = build-aux/gitlog-to-changelog-repro
|
||||
|
||||
clean-local:
|
||||
$(MAKE) $(AM_MAKEFLAGS) -L -C tests/spec clean
|
||||
|
||||
|
|
72
NEWS
72
NEWS
|
@ -1,6 +1,76 @@
|
|||
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)
|
||||
================================================
|
||||
|
||||
New features
|
||||
|
||||
- Pattern-based and asserting variable operators ('#', '##', '%',
|
||||
'%%', and '?') are now supported.
|
||||
- Errors are now handled in the 'break', 'continue', and 'return'
|
||||
special built-ins.
|
||||
- Temporary variable assignments are now passed into function calls
|
||||
and invocations of regular built-ins.
|
||||
- The 'read' special built-in now supports field splitting and
|
||||
logical lines.
|
||||
- The IFS variable is now initialized with a value.
|
||||
- The 'trap' special built-in now uses '-' if no action is given.
|
||||
- The 'noglob' option can be used to turn off globbing.
|
||||
|
||||
Bug fixes
|
||||
|
||||
- Subshells no longer continue executing code from the parent shell.
|
||||
- The 'exit' special built-in now runs the exit handler.
|
||||
- Patterns can now contain malformed, unterminated bracket
|
||||
expressions (e.g., '[-foo').
|
||||
- Nested variable references that are interpreted as strings now
|
||||
work (e.g., 'x=${y+${z+foo}}').
|
||||
- Backtick command substitutions in double quotes are now parsed
|
||||
"correctly" (i.e., in the same bizarre way as other shells).
|
||||
- Case statements that have unbalanced parentheses and are nested
|
||||
inside of command substitutions are now parsed correctly.
|
||||
- The behavior of the '+' and ':+' variable operators are no longer
|
||||
reversed.
|
||||
- Pathname expansion now works for absolute paths, paths with quoted
|
||||
slashes, paths with repeated slashes, and paths with dot and
|
||||
dot-dot components.
|
||||
- Files opened for redirect are now closed immediately after they
|
||||
are used.
|
||||
- Processes spawned for pipelines are now reaped.
|
||||
|
||||
Miscellaneous improvements
|
||||
|
||||
- Gash is now installed into Guile's 'site' directories.
|
||||
- The source tarball can now be generated reproducibly from a Git
|
||||
checkout.
|
||||
|
||||
Noteworthy features of release 0.1 (2019-06-01)
|
||||
===============================================
|
||||
|
||||
|
@ -8,7 +78,7 @@ Features of the shell
|
|||
|
||||
- Sophisticated enough to be used to build Bash.
|
||||
- Has a nice colorized prompt.
|
||||
- Includes all of the POSIX-specified "special" built-ins expect for
|
||||
- Includes all of the POSIX-specified "special" built-ins except for
|
||||
'times'.
|
||||
- Includes about half of the POSIX-specified "regular" built-ins
|
||||
(see 'gash/built-ins.scm' for details).
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -0,0 +1,16 @@
|
|||
This patch adjusts the 'gitlog-to-changelog' script from Gnulib so
|
||||
that its output is reproducible.
|
||||
|
||||
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
|
||||
index deddef2..6fec950 100755
|
||||
--- a/build-aux/gitlog-to-changelog
|
||||
+++ b/build-aux/gitlog-to-changelog
|
||||
@@ -345,7 +345,7 @@ sub git_dir_option($)
|
||||
? ' (tiny change)' : '');
|
||||
|
||||
my $date_line = sprintf "%s %s$tiny\n",
|
||||
- strftime ("%Y-%m-%d", localtime ($1)), $2;
|
||||
+ strftime ("%Y-%m-%d", gmtime ($1)), $2;
|
||||
|
||||
my @coauthors = grep /^Co-authored-by:.*$/, @line;
|
||||
# Omit meta-data lines we've already interpreted.
|
|
@ -31,9 +31,9 @@ GUILE_WARNINGS = \
|
|||
-Warity-mismatch \
|
||||
-Wformat
|
||||
|
||||
moddir = $(datadir)/guile/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
|
||||
moddir = $(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
|
||||
nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
|
||||
ccachedir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache/$(modpath)
|
||||
ccachedir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/$(modpath)
|
||||
nobase_ccache_DATA = $(GOBJECTS)
|
||||
EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
|
||||
|
||||
|
|
|
@ -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])
|
||||
|
@ -41,6 +41,7 @@ AC_CONFIG_FILES([Makefile])
|
|||
AC_CONFIG_FILES([gash/config.scm])
|
||||
AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
|
||||
[chmod +x pre-inst-env])
|
||||
AC_CONFIG_FILES([tests/run-test-suite], [chmod +x tests/run-test-suite])
|
||||
AC_CONFIG_FILES([tests/unit/config.scm])
|
||||
AC_CONFIG_FILES([tests/spec/Makefile])
|
||||
AC_CONFIG_FILES([tools/coverage], [chmod +x tools/coverage])
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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)))
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -17,8 +17,10 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins break)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment))
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,11 +29,18 @@
|
|||
;;; Code:
|
||||
|
||||
(define (main . args)
|
||||
(let* ((arg (and (pair? args) (car args)))
|
||||
(n (string->number (or arg "1"))))
|
||||
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
|
||||
1
|
||||
(begin
|
||||
;; Since we do not return, we have to set the status here.
|
||||
(set-status! 0)
|
||||
(sh:break (1- n))))))
|
||||
(match args
|
||||
(() (main "1"))
|
||||
((arg)
|
||||
(match (string->positive-integer arg)
|
||||
(#f (format (current-error-port)
|
||||
"gash: break: argument must be a positive integer~%")
|
||||
(throw 'shell-error))
|
||||
(n (set-status! 0)
|
||||
(sh:break (1- n))
|
||||
(format (current-error-port)
|
||||
"gash: break: no loop to break from~%")
|
||||
EXIT_SUCCESS)))
|
||||
(_ (format (current-error-port)
|
||||
"gash: break: too many arguments~%")
|
||||
(throw 'shell-error))))
|
||||
|
|
|
@ -17,8 +17,10 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins continue)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment))
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,11 +29,18 @@
|
|||
;;; Code:
|
||||
|
||||
(define (main . args)
|
||||
(let* ((arg (and (pair? args) (car args)))
|
||||
(n (string->number (or arg "1"))))
|
||||
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
|
||||
1
|
||||
(begin
|
||||
;; Since we do not return, we have to set the status here.
|
||||
(set-status! 0)
|
||||
(sh:continue (1- n))))))
|
||||
(match args
|
||||
(() (main "1"))
|
||||
((arg)
|
||||
(match (string->positive-integer arg)
|
||||
(#f (format (current-error-port)
|
||||
"gash: continue: argument must be a positive integer~%")
|
||||
(throw 'shell-error))
|
||||
(n (set-status! 0)
|
||||
(sh:continue (1- n))
|
||||
(format (current-error-port)
|
||||
"gash: continue: no loop to continue from~%")
|
||||
EXIT_SUCCESS)))
|
||||
(_ (format (current-error-port)
|
||||
"gash: continue: too many arguments~%")
|
||||
(throw 'shell-error))))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
|
@ -17,9 +17,13 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins read)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash compat textual-ports)
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim))
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,8 +31,78 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (read-logical-line #:optional (port (current-input-port)))
|
||||
"Return a ``logical'' line from @var{port} if specified, otherwise
|
||||
from the value returned by @code{(current-input-port)}. A logical
|
||||
line allows ignoring a newline character by prefixing it with a
|
||||
backslash."
|
||||
(let loop ((acc '()))
|
||||
(match (get-char port)
|
||||
((? eof-object? eof) (cons (reverse-list->string acc) eof))
|
||||
(#\newline (cons (reverse-list->string acc) #\newline))
|
||||
(#\\ (match (get-char port)
|
||||
((? eof-object? eof) (cons (reverse-list->string acc) eof))
|
||||
(#\newline (loop acc))
|
||||
(chr (loop (cons chr acc)))))
|
||||
(chr (loop (cons chr acc))))))
|
||||
|
||||
;; The '(gash word)' module already has a 'split-fields' procedure.
|
||||
;; However, we need to be able to specify a maximum number of fields,
|
||||
;; which it cannot do. We could extend it, but it has to deal with
|
||||
;; quotes, which we do not here. It is simpler to write a specialized
|
||||
;; version that can deal with 'max' without quotes than it is to
|
||||
;; extend the more general version.
|
||||
(define* (split-fields str max hard-delims soft-delims
|
||||
#:optional (start 0) (end (string-length str)))
|
||||
"Split @var{str} into at most @var{max} fields. Each individual
|
||||
occurrence of a character in the set @var{hard-delims} delimits a
|
||||
field, while contiguous sequences of characters from the set
|
||||
@var{soft-delims} are treated as a single delimiter."
|
||||
(define non-soft-delims (char-set-complement soft-delims))
|
||||
(define all-delims (char-set-union hard-delims soft-delims))
|
||||
|
||||
(define* (field+next-index str i)
|
||||
(let* ((end* (or (string-index str all-delims i end) end))
|
||||
(start* (string-index str non-soft-delims end* end)))
|
||||
(values (substring str i end*)
|
||||
(if (and start*
|
||||
(char-set-contains? hard-delims
|
||||
(string-ref str start*)))
|
||||
(or (string-index str non-soft-delims (1+ start*) end) end)
|
||||
start*))))
|
||||
|
||||
(cond
|
||||
((string-index str non-soft-delims start end)
|
||||
=> (lambda (start*)
|
||||
(let loop ((i start*) (count 0) (acc '()))
|
||||
(if (>= count (1- max))
|
||||
(reverse! (cons (string-trim-right str soft-delims i end) acc))
|
||||
(call-with-values (lambda () (field+next-index str i))
|
||||
(lambda (field i*)
|
||||
(if i*
|
||||
(loop i* (1+ count) (cons field acc))
|
||||
(reverse! (cons field acc)))))))))
|
||||
(else '())))
|
||||
|
||||
(define (main . args)
|
||||
(match (read-line (current-input-port))
|
||||
((? eof-object?) 1)
|
||||
(str (setvar! (car args) str)
|
||||
0)))
|
||||
(match-let* (((vars . get-line)
|
||||
(match args
|
||||
(("-r" vars ...)
|
||||
(cons vars (cut read-line (current-input-port) 'split)))
|
||||
((vars ...)
|
||||
(cons vars read-logical-line))))
|
||||
(limit (length vars))
|
||||
((line . delimiter) (get-line))
|
||||
(dflt (string #\space #\tab #\newline))
|
||||
(ifs (string->char-set (getvar "IFS" dflt)))
|
||||
(ifs/w (char-set-intersection ifs char-set:whitespace))
|
||||
(ifs/nw (char-set-difference ifs char-set:whitespace))
|
||||
(fields (split-fields line limit ifs/nw ifs/w)))
|
||||
(for-each (lambda (var field)
|
||||
;; XXX: Verify that VAR is a valid variable name.
|
||||
(setvar! var field))
|
||||
vars
|
||||
(append fields (circular-list "")))
|
||||
(if (eof-object? delimiter)
|
||||
EXIT_FAILURE
|
||||
EXIT_SUCCESS)))
|
||||
|
|
|
@ -17,8 +17,10 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins return)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment))
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,16 +29,18 @@
|
|||
;;; Code:
|
||||
|
||||
(define (main . args)
|
||||
(let* ((arg (or (and (pair? args)
|
||||
(car (last-pair args)))
|
||||
(number->string (get-status))
|
||||
"0"))
|
||||
(number (string->number arg))
|
||||
(status (or (and (exact-integer? number)
|
||||
(>= number 0)
|
||||
(<= number 256)
|
||||
number)
|
||||
;; If the above is not true, the exit status is
|
||||
;; undefined.
|
||||
EXIT_FAILURE)))
|
||||
(sh:return status)))
|
||||
(match args
|
||||
(() (main (number->string (get-status))))
|
||||
((arg)
|
||||
(match (string->exit-status arg)
|
||||
(#f (format (current-error-port)
|
||||
"gash: return: argument must be a number from 0 to 255~%")
|
||||
(throw 'shell-error))
|
||||
(n (sh:return n)
|
||||
(format (current-error-port)
|
||||
(string-append "gash: return: no function "
|
||||
"or sourced script to return from~%"))
|
||||
EXIT_SUCCESS)))
|
||||
(_ (format (current-error-port)
|
||||
"gash: return: too many arguments~%")
|
||||
(throw 'shell-error))))
|
||||
|
|
|
@ -44,8 +44,8 @@
|
|||
(format (current-error-port)
|
||||
"~a: shift: Invalid option ~s.~%"
|
||||
(car (program-arguments)) n-string)
|
||||
EXIT_FAILURE))))
|
||||
(throw 'shell-error)))))
|
||||
(_ (format (current-error-port)
|
||||
"~a: shift: Invalid options ~s.~%"
|
||||
(car (program-arguments)) args)
|
||||
EXIT_FAILURE)))
|
||||
(throw 'shell-error))))
|
||||
|
|
|
@ -17,6 +17,7 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins trap)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
@ -54,6 +55,8 @@
|
|||
(match args
|
||||
(() "print")
|
||||
(("--" . args) (main args))
|
||||
(((? string->nonnegative-integer n) conditions ...)
|
||||
(apply main (cons "-" args)))
|
||||
((action conditions ..1)
|
||||
(let ((handler (action->handler action)))
|
||||
(for-each (lambda (condition)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -17,10 +17,14 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (get-evaluator
|
||||
built-in?
|
||||
split-assignment))
|
||||
split-assignment
|
||||
string->positive-integer
|
||||
string->nonnegative-integer
|
||||
string->exit-status))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -53,3 +57,30 @@
|
|||
(match (substring assignment (1+ index))
|
||||
((? string-null?) (values name #f))
|
||||
(value (values name value)))))))
|
||||
|
||||
(define char-set:ascii-digit
|
||||
(char-set-intersection char-set:ascii char-set:digit))
|
||||
|
||||
(define (string->positive-integer s)
|
||||
"Return the positive integer represented by the string @var{s}. If
|
||||
@var{s} does not represent a positive, decimal integer return
|
||||
@code{#f}."
|
||||
(and=> (and (string-every char-set:ascii-digit s) (string->number s))
|
||||
(lambda (n)
|
||||
(and (exact-integer? n) (> n 0) n))))
|
||||
|
||||
(define (string->nonnegative-integer s)
|
||||
"Return the nonnegative integer represented by the string @var{s}.
|
||||
If @var{s} does not represent a nonnegative, decimal integer return
|
||||
@code{#f}."
|
||||
(and=> (and (string-every char-set:ascii-digit s) (string->number s))
|
||||
(lambda (n)
|
||||
(and (exact-integer? n) (>= n 0) n))))
|
||||
|
||||
(define (string->exit-status s)
|
||||
"Return the exit status represented by the string @var{s}. If
|
||||
@var{s} does not represent an exit status (a decimal integer from 0 to
|
||||
255) return @code{#f}."
|
||||
(and=> (and (string-every char-set:ascii-digit s) (string->number s))
|
||||
(lambda (n)
|
||||
(and (exact-integer? n) (>= n 0) (<= n 255) n))))
|
||||
|
|
|
@ -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))))
|
|
@ -46,7 +46,11 @@
|
|||
(syntax->datum #'min)
|
||||
(syntax->datum #'mic))
|
||||
#'consequent
|
||||
#'alternate)))))
|
||||
#'alternate))
|
||||
((_ (maj min mic) consequent)
|
||||
#'(if-guile-version-below (maj min mic)
|
||||
consequent
|
||||
(if #f #t))))))
|
||||
|
||||
(if-guile-version-below (2 0 10)
|
||||
(begin
|
||||
|
@ -55,8 +59,7 @@
|
|||
(define-public EXIT_FAILURE 1)
|
||||
|
||||
(define-public (exact-integer? x)
|
||||
(and (integer? x) (exact? x))))
|
||||
#f)
|
||||
(and (integer? x) (exact? x)))))
|
||||
|
||||
(if-guile-version-below (2 2 0)
|
||||
(begin
|
||||
|
@ -66,5 +69,4 @@
|
|||
('line _IOLBF)
|
||||
('block _IOFBF))))
|
||||
((@ (guile) setvbuf) port mode size)))
|
||||
(export! setvbuf))
|
||||
#f)
|
||||
(export! setvbuf)))
|
||||
|
|
|
@ -0,0 +1,41 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2019 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 compat srfi-43)
|
||||
#:use-module (gash compat))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; The '(srfi srfi-43)' module was introduced into Guile in version
|
||||
;;; 2.0.10, so we provide a shim.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(if-guile-version-below (2 0 10)
|
||||
(begin
|
||||
(define-public (vector-empty? vec)
|
||||
(zero? (vector-length vec)))
|
||||
;; We only need the single vector version.
|
||||
(define-public (vector-every pred? vec)
|
||||
(let loop ((i 0) (value #t))
|
||||
(if (< i (vector-length vec))
|
||||
(and value (loop (1+ i) (pred? (vector-ref vec i))))
|
||||
value))))
|
||||
(begin
|
||||
(use-modules (srfi srfi-43))
|
||||
(re-export vector-empty? vector-every)))
|
|
@ -1,5 +1,6 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
|
@ -32,6 +33,7 @@
|
|||
(re-export get-char
|
||||
get-line
|
||||
get-string-all
|
||||
put-char
|
||||
lookahead-char)
|
||||
(define-public (unget-char port char)
|
||||
(unread-char char port)))
|
||||
|
@ -41,4 +43,5 @@
|
|||
get-line
|
||||
get-string-all
|
||||
lookahead-char
|
||||
put-char
|
||||
unget-char)))
|
||||
|
|
|
@ -33,6 +33,7 @@
|
|||
read-only?
|
||||
set-read-only!
|
||||
with-variables
|
||||
save-variables-excursion
|
||||
get-environ
|
||||
with-environ
|
||||
getfun
|
||||
|
@ -52,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:
|
||||
;;;
|
||||
|
@ -114,7 +118,8 @@
|
|||
(alist->hash-table
|
||||
(map (match-lambda
|
||||
((name . value) `(,name . ,(vector value #t #f))))
|
||||
(append `(("PWD" . ,(initial-pwd env))
|
||||
(append `(("IFS" . " \t\n")
|
||||
("PWD" . ,(initial-pwd env))
|
||||
("SHELL" . ,(car (command-line)))
|
||||
("SHELLOPTS" . ""))
|
||||
env)))))
|
||||
|
@ -202,6 +207,26 @@ extent of @var{thunk}."
|
|||
(set! inside-variables *variables*)
|
||||
(set! outside-variables *variables*)))))
|
||||
|
||||
(define (save-variables-excursion names thunk)
|
||||
"Save the variables listed in @var{names}, and call @var{thunk}. When
|
||||
@var{thunk}'s dynamic extent is left, restore the variables to their
|
||||
saved state."
|
||||
(let ((saved-variables #f))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(set! saved-variables
|
||||
(map (lambda (name)
|
||||
(match (hash-ref *variables* name)
|
||||
((? vector? vec) (cons name (vector-copy vec)))
|
||||
(x (cons name x))))
|
||||
names)))
|
||||
thunk
|
||||
(lambda ()
|
||||
(for-each (match-lambda
|
||||
((name . #f) (hash-remove! *variables* name))
|
||||
((name . value) (hash-set! *variables* name value)))
|
||||
saved-variables)))))
|
||||
|
||||
(define* (get-environ #:optional (bindings '()))
|
||||
"Return a value that represents the set of current variables is
|
||||
suitable for passing to @code{environ}. If @var{bindings} is set,
|
||||
|
@ -334,8 +359,9 @@ exit the dynamic extent of @var{thunk}."
|
|||
|
||||
(define* (sh:continue #:optional (n 0))
|
||||
"Exit to the closest invocation of @code{call-with-continue}. If
|
||||
@var{n} is set, exit to the @math{n + 1}th closest invocation."
|
||||
(abort-to-prompt *continue-tag* n))
|
||||
@var{n} is set, exit to the @math{n + 1}th closest invocation. If not
|
||||
called from within @code{call-with-continue}, return @code{#f}."
|
||||
(false-if-exception (abort-to-prompt *continue-tag* n)))
|
||||
|
||||
(define *break-tag* (make-prompt-tag))
|
||||
|
||||
|
@ -351,8 +377,9 @@ exit the dynamic extent of @var{thunk}."
|
|||
|
||||
(define* (sh:break #:optional (n 0))
|
||||
"Exit to the closest invocation of @code{call-with-break}. If
|
||||
@var{n} is set, exit to the @math{n + 1}th closest invocation."
|
||||
(abort-to-prompt *break-tag* n))
|
||||
@var{n} is set, exit to the @math{n + 1}th closest invocation. If not
|
||||
called from within @code{call-with-break}, return @code{#f}."
|
||||
(false-if-exception (abort-to-prompt *break-tag* n)))
|
||||
|
||||
(define *return-tag* (make-prompt-tag))
|
||||
|
||||
|
@ -367,8 +394,9 @@ exit the dynamic extent of @var{thunk}."
|
|||
(define* (sh:return #:optional (status (get-status)))
|
||||
"Exit to the closest invocation of @code{call-with-return} setting
|
||||
status to @var{status}. If @var{status} is not set, keep the current
|
||||
status."
|
||||
(abort-to-prompt *return-tag* status))
|
||||
status. If not called from within @code{call-with-return}, return
|
||||
@code{#f}."
|
||||
(false-if-exception (abort-to-prompt *return-tag* status)))
|
||||
|
||||
(define *atexit* #f)
|
||||
(define *exiting?* #f)
|
||||
|
@ -413,3 +441,21 @@ status."
|
|||
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)))))
|
||||
|
|
114
gash/eval.scm
114
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,8 +36,95 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (eval-word word #:key (output 'fields) (rhs-tildes? #f))
|
||||
(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)
|
||||
(on-command-substitution)
|
||||
(sh:substitute-command
|
||||
(lambda ()
|
||||
(for-each eval-sh exps))))))
|
||||
|
@ -57,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
|
||||
|
@ -66,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) ...)
|
||||
|
@ -124,11 +216,15 @@
|
|||
(('<sh-pipeline> cmd*s ..1)
|
||||
(apply sh:pipeline (map exp->thunk cmd*s)))
|
||||
(('<sh-set!> (names words) ..1)
|
||||
(for-each (lambda (name word)
|
||||
(setvar! name (eval-word word
|
||||
#:output 'string
|
||||
#:rhs-tildes? #t)))
|
||||
names words))
|
||||
(let* ((command-substitution? #f)
|
||||
(thunk (lambda () (set! command-substitution? #t))))
|
||||
(for-each (lambda (name word)
|
||||
(setvar! name (eval-word word
|
||||
#:output 'string
|
||||
#:rhs-tildes? #t
|
||||
#:on-command-substitution thunk)))
|
||||
names words)
|
||||
(unless command-substitution? (set-status! 0))))
|
||||
(('<sh-subshell> . sub-exps)
|
||||
(sh:subshell (exps->thunk sub-exps)))
|
||||
(('<sh-while> test-exp sub-exps ..1)
|
||||
|
|
|
@ -3,6 +3,14 @@
|
|||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; The careful invocation of 'seclocale' was taken from the
|
||||
;;; 'module/ice-9/top-repl.scm' file in GNU Guile, which has the
|
||||
;;; following copyright notice:
|
||||
;;;
|
||||
;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||
;;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2013 Free
|
||||
;;; Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
;;; Gash is free software; you can redistribute it and/or modify it
|
||||
|
@ -19,6 +27,7 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash gash)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash environment)
|
||||
#:use-module (gash eval)
|
||||
|
@ -42,6 +51,17 @@
|
|||
(lambda (key . args)
|
||||
(use-modules (gash readline)))))
|
||||
|
||||
;; This is done automatically since Guile 2.2.
|
||||
(if-guile-version-below (2 2 0)
|
||||
(and (defined? 'setlocale)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(setlocale LC_ALL ""))
|
||||
(lambda (key subr fmt args errno)
|
||||
(format (current-error-port)
|
||||
"warning: failed to install locale: ~a~%"
|
||||
(strerror (car errno)))))))
|
||||
|
||||
(define (display-help)
|
||||
(display (string-append "\
|
||||
Usage: gash [OPTION]... [FILE]...
|
||||
|
@ -110,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
|
||||
|
|
|
@ -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)
|
||||
|
@ -180,7 +185,8 @@ character."
|
|||
(define read-backquoted-command
|
||||
;; A procedure for reading a backquoted command (e.g, "`command`").
|
||||
;; This is parameterized to avoid a circular dependency.
|
||||
(make-parameter (lambda (port) (throw 'backquoted-command-parser-unset))))
|
||||
(make-parameter (lambda* (port #:key quoted?)
|
||||
(throw 'backquoted-command-parser-unset))))
|
||||
|
||||
(define* (get-parameter port #:key (multidigit? #f))
|
||||
"Get a parameter name (excluding the leading '$') from @var{port}.
|
||||
|
@ -319,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 '$')."
|
||||
|
@ -328,24 +376,31 @@ leading '$')."
|
|||
(match (get-char port)
|
||||
(#\) `(<sh-cmd-sub> ,@result)))))))
|
||||
|
||||
(define (get-backquoted-command port)
|
||||
"Get a backquoted command ('`...`') from @var{port}."
|
||||
(define* (get-backquoted-command port #:key quoted?)
|
||||
"Get a backquoted command ('`...`') from @var{port}. If
|
||||
@var{quoted?} is set, treat the backquoted command as if it were
|
||||
quoted."
|
||||
(match (get-char port)
|
||||
(#\`
|
||||
(let ((result ((read-backquoted-command) port)))
|
||||
(let ((result ((read-backquoted-command) port #:quoted? quoted?)))
|
||||
(match (get-char port)
|
||||
(#\` `(<sh-cmd-sub> ,@result)))))))
|
||||
|
||||
(define (get-expansion port)
|
||||
(define* (get-expansion port #:key quoted?)
|
||||
"Get an expansion ('$name', '${...}', '$(...)', or '`...`') from
|
||||
@var{port}."
|
||||
@var{port}. If @var{quoted?} is set, treat backquoted commands as if
|
||||
they were quoted."
|
||||
(match (lookahead-char port)
|
||||
(#\$ (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))))
|
||||
(#\` (get-backquoted-command port #:quoted? quoted?))))
|
||||
|
||||
;; When this parameter is true, expansion processing is enabled.
|
||||
(define expansions? (make-parameter #t))
|
||||
|
@ -395,7 +450,7 @@ next character statisfies @var{pred} (or is a newline)."
|
|||
(words words)))))
|
||||
((or #\$ #\`)
|
||||
(if (expansions?)
|
||||
(let ((expansion (get-expansion port)))
|
||||
(let ((expansion (get-expansion port #:quoted? #t)))
|
||||
(loop (lookahead-char port)
|
||||
(cons (or expansion (string chr)) acc)))
|
||||
(loop (next-char port) (cons (string chr) acc))))
|
||||
|
|
|
@ -398,6 +398,8 @@ the same number of times.)"
|
|||
(LPAREN! pattern RPAREN! compound-list DSEMI linebreak)
|
||||
: `(,$2 ,@$4))
|
||||
|
||||
;; If this rule is updated, the hooked version given below must be
|
||||
;; updated as well.
|
||||
(pattern
|
||||
(WORD*-without-Esac)
|
||||
: `(,$1)
|
||||
|
@ -683,11 +685,14 @@ the same number of times.)"
|
|||
|
||||
;; Sometimes a "pattern" non-terminal comes before an unbalanced
|
||||
;; "RPAREN". This reduction hook can be used to pretend that we
|
||||
;; encountered an "LPAREN".
|
||||
;; encountered an "LPAREN". It should match the unhooked one given
|
||||
;; above.
|
||||
|
||||
(pattern!
|
||||
(pattern)
|
||||
: (begin (open-bracket-hook) $1))))
|
||||
(WORD*-without-Esac)
|
||||
: (begin (open-bracket-hook) `(,$1))
|
||||
(pattern! PIPE WORD*)
|
||||
: (append $1 `(,$3)))))
|
||||
|
||||
(define* (syntax-error message #:optional token)
|
||||
"Handle a parser error"
|
||||
|
@ -750,10 +755,17 @@ ignored."
|
|||
(((? symbol? tag) . rest) `((,tag . ,rest)))
|
||||
(code code)))
|
||||
|
||||
(define (call-with-backquoted-input-port port proc)
|
||||
(define* (call-with-backquoted-input-port port proc #:key quoted?)
|
||||
"Call @var{proc} with a wrapped version of @var{port} that will
|
||||
return the end-of-file object upon encountering an unescaped backquote
|
||||
\"`\" (without consuming the backquote)."
|
||||
\"`\" (without consuming the backquote). If @var{quoted?} is set,
|
||||
treat the double quote character as escapable."
|
||||
(define (escape-char? chr)
|
||||
(or (char=? chr #\$)
|
||||
(char=? chr #\`)
|
||||
(char=? chr #\\)
|
||||
(and quoted? (char=? chr #\"))))
|
||||
|
||||
(define wrapped-port
|
||||
(make-soft-port
|
||||
(vector
|
||||
|
@ -766,7 +778,7 @@ return the end-of-file object upon encountering an unescaped backquote
|
|||
(#\\ (begin
|
||||
(get-char port)
|
||||
(match (lookahead-char port)
|
||||
((or #\$ #\` #\\) (get-char port))
|
||||
((? escape-char?) (get-char port))
|
||||
(_ #\\))))
|
||||
(_ (get-char port))))
|
||||
;; close-port
|
||||
|
@ -796,24 +808,24 @@ bracket."
|
|||
#:open-bracket-hook incr-bracket-depth!
|
||||
#:close-bracket-hook decr-bracket-depth!)))
|
||||
|
||||
(define (read-sh/backquoted port)
|
||||
"Read Shell code from @var{port} until the first unescaped backquote."
|
||||
(define* (read-sh/backquoted port #:key quoted?)
|
||||
"Read Shell code from @var{port} until the first unescaped
|
||||
backquote. If @var{quoted?} is set, treat the double quote character
|
||||
as escapable."
|
||||
(call-with-backquoted-input-port port
|
||||
(lambda (port)
|
||||
(->command-list (parse port)))))
|
||||
(->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)))
|
||||
|
|
273
gash/pattern.scm
273
gash/pattern.scm
|
@ -1,5 +1,5 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
|
@ -20,11 +20,21 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (gash compat srfi-43)
|
||||
#:export (parse-pattern
|
||||
pattern-quote
|
||||
pattern-null?
|
||||
pattern-plain?
|
||||
pattern-match?))
|
||||
pattern-match?
|
||||
pattern-drop
|
||||
pattern-drop-right))
|
||||
|
||||
(define-immutable-record-type <pattern>
|
||||
(make-pattern parts)
|
||||
pattern?
|
||||
(parts pattern-parts))
|
||||
|
||||
(define* (parse-rdelim s1 s2 #:optional (start 0) (end (string-length s1)))
|
||||
|
||||
|
@ -72,42 +82,48 @@
|
|||
|
||||
(define* (parse-matching-bracket-expression s #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
(let loop ((i start) (acc '()))
|
||||
(let loop ((i start) (acc '()) (errors '()))
|
||||
(match (and (< i end) (string-ref s i))
|
||||
(#f (values #f 0))
|
||||
(#\] (if (= i start)
|
||||
(loop (1+ i) (cons #\] acc))
|
||||
(values (list->char-set acc) (1+ (- i start)))))
|
||||
(loop (1+ i) (cons #\] acc) errors)
|
||||
(match errors
|
||||
(() (values (list->char-set acc) (1+ (- i start))))
|
||||
(_ (throw (last errors))))))
|
||||
(#\[ (match (and (< (1+ i) end) (string-ref s (1+ i)))
|
||||
(#\. (receive (result length)
|
||||
(parse-collating-symbol s (+ i 2) end)
|
||||
(if result
|
||||
(throw 'pattern-collating-symbol)
|
||||
(loop (1+ i) (cons #\[ acc)))))
|
||||
(loop (+ i length 1) acc
|
||||
(cons 'pattern-collating-symbol errors))
|
||||
(loop (1+ i) (cons #\[ acc) errors))))
|
||||
(#\= (receive (result length)
|
||||
(parse-equivalence-class s (+ i 2) end)
|
||||
(if result
|
||||
(throw 'pattern-equivalence-class)
|
||||
(loop (1+ i) (cons #\[ acc)))))
|
||||
(loop (+ i length 1) acc
|
||||
(cons 'pattern-equivalence-class errors))
|
||||
(loop (1+ i) (cons #\[ acc) errors))))
|
||||
(#\: (receive (result length)
|
||||
(parse-character-class s (+ i 2) end)
|
||||
(if result
|
||||
(throw 'pattern-character-class)
|
||||
(loop (1+ i) (cons #\[ acc)))))
|
||||
(_ (loop (1+ i) (cons #\[ acc)))))
|
||||
(loop (+ i length 1) acc
|
||||
(cons 'pattern-character-class errors))
|
||||
(loop (1+ i) (cons #\[ acc) errors))))
|
||||
(_ (loop (1+ i) (cons #\[ acc) errors))))
|
||||
(#\- (if (or (= i start)
|
||||
(and (< (1+ i) end) (char=? (string-ref s (1+ i)) #\])))
|
||||
(loop (1+ i) (cons #\- acc))
|
||||
(loop (1+ i) (cons #\- acc) errors)
|
||||
(let ((alpha (and (pair? acc) (car acc)))
|
||||
;; XXX: Escaped range end?
|
||||
(omega (and (< (1+ i) end) (string-ref s (1+ i)))))
|
||||
(match (character-range alpha omega)
|
||||
(#f (throw 'pattern-range-expression))
|
||||
(chrs (loop (+ i 2) (append chrs acc)))))))
|
||||
(#f (loop (+ i 2) acc
|
||||
(cons 'pattern-range-expression errors)))
|
||||
(chrs (loop (+ i 2) (append chrs acc) errors))))))
|
||||
(#\\ (if (< (1+ i) end)
|
||||
(loop (+ i 2) (cons (string-ref s (1+ i)) acc))
|
||||
(loop (1+ i) acc)))
|
||||
(chr (loop (1+ i) (cons chr acc))))))
|
||||
(loop (+ i 2) (cons (string-ref s (1+ i)) acc) errors)
|
||||
(loop (1+ i) acc errors)))
|
||||
(chr (loop (1+ i) (cons chr acc) errors)))))
|
||||
|
||||
(define* (parse-bracket-expression s #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
|
@ -119,28 +135,41 @@
|
|||
(values result length)
|
||||
(values (char-set-complement! result) (1+ length))))))
|
||||
|
||||
(define* (parse-pattern s #:optional (start 0) (end (string-length s)))
|
||||
"Parse the string @var{s} as a pattern."
|
||||
(let loop ((i start) (parts '()) (acc '()))
|
||||
(define* (parse-part s #:optional (start 0) (end (string-length s)))
|
||||
(let loop ((i start) (acc '()))
|
||||
(match (and (< i end) (string-ref s i))
|
||||
(#f (if (null? acc)
|
||||
(reverse! parts)
|
||||
(reverse! (cons (reverse! acc) parts))))
|
||||
(#\* (if (null? acc)
|
||||
(loop (1+ i) (cons '* parts) '())
|
||||
(loop (1+ i) (cons* '* (reverse! acc) parts) '())))
|
||||
(#\? (loop (1+ i) parts (cons '? acc)))
|
||||
(#f (match acc
|
||||
(() (values #f 0))
|
||||
(_ (values (list->vector (reverse! acc)) (- i start)))))
|
||||
(#\* (match acc
|
||||
(() (values '* 1))
|
||||
(_ (values (list->vector (reverse! acc)) (- i start)))))
|
||||
(#\? (loop (1+ i) (cons char-set:full acc)))
|
||||
(#\[ (if (< (1+ i) end)
|
||||
(receive (result length)
|
||||
(parse-bracket-expression s (1+ i) end)
|
||||
(if result
|
||||
(loop (+ i length 1) parts (cons result acc))
|
||||
(loop (1+ i) parts (cons #\[ acc))))
|
||||
(loop (1+ i) parts (cons #\[ acc))))
|
||||
(loop (+ i length 1) (cons result acc))
|
||||
(loop (1+ i) (cons #\[ acc))))
|
||||
(loop (1+ i) (cons #\[ acc))))
|
||||
(#\\ (if (< (1+ i) end)
|
||||
(loop (+ i 2) parts (cons (string-ref s (1+ i)) acc))
|
||||
(loop (1+ i) parts acc)))
|
||||
(chr (loop (1+ i) parts (cons chr acc))))))
|
||||
(loop (+ i 2) (cons (string-ref s (1+ i)) acc))
|
||||
(loop (1+ i) acc)))
|
||||
(chr (loop (1+ i) (cons chr acc))))))
|
||||
|
||||
(define* (parse-pattern s #:optional (start 0) (end (string-length s)))
|
||||
"Parse the string @var{s} as a pattern."
|
||||
(let loop ((i start) (parts '()))
|
||||
(receive (part length) (parse-part s i end)
|
||||
(match part
|
||||
(#f (make-pattern (reverse! parts)))
|
||||
('* (match parts
|
||||
(() (loop (+ i length) (list #() #())))
|
||||
((#() . _) (loop (+ i length) parts))
|
||||
(_ (loop (+ i length) (cons #() parts)))))
|
||||
(_ (match parts
|
||||
((#() . rest) (loop (+ i length) (cons part rest)))
|
||||
(_ (loop (+ i length) (cons part parts)))))))))
|
||||
|
||||
(define pattern-quote
|
||||
(let ((specials '(#\\ #\* #\? #\[ #\] #\! #\-)))
|
||||
|
@ -155,99 +184,123 @@ them are treated specially when @var{s} is interpreted as a pattern."
|
|||
'()
|
||||
s)))))
|
||||
|
||||
(define (pattern-null? pattern)
|
||||
(match (pattern-parts pattern)
|
||||
(() #t)
|
||||
((part) (vector-empty? part))
|
||||
(_ #f)))
|
||||
|
||||
(define (pattern-plain? pattern)
|
||||
"Check if @var{pattern} free of special pattern constructions like
|
||||
asterisks and bracket expressions. If a pattern is ``plain'' its
|
||||
source string is the only string that will match it."
|
||||
(every (match-lambda
|
||||
('* #f)
|
||||
(parts (every (match-lambda
|
||||
((or (? char?) (? string?)) #t)
|
||||
(_ #f))
|
||||
parts)))
|
||||
pattern))
|
||||
(match (pattern-parts pattern)
|
||||
(() #t)
|
||||
((part) (vector-every char? part))
|
||||
(_ #f)))
|
||||
|
||||
(define* (string-starts-with-part s part #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
(let loop ((part part) (i start))
|
||||
(match (and (< i end) part)
|
||||
(#f (match part
|
||||
(() (- i start))
|
||||
(((? string? s2) . rest)
|
||||
(and (string-null? s2)
|
||||
(loop rest i)))
|
||||
(_ #f)))
|
||||
(() (- i start))
|
||||
(('? . rest) (loop rest (1+ i)))
|
||||
(((? string? s2) . rest)
|
||||
(and (string-prefix? s2 s 0 (string-length s2) i end)
|
||||
(loop rest (+ i (string-length s2)))))
|
||||
(((? char? chr) . rest)
|
||||
(and (char=? (string-ref s i) chr)
|
||||
(loop rest (1+ i))))
|
||||
(((? char-set? cs) . rest)
|
||||
(and (char-set-contains? cs (string-ref s i))
|
||||
(loop rest (1+ i)))))))
|
||||
|
||||
(define (pattern-part-length part)
|
||||
(let loop ((part part) (length 0))
|
||||
(match part
|
||||
(() length)
|
||||
(((? string? str) . rest) (loop rest (+ length (string-length str))))
|
||||
((first . rest) (loop rest (1+ length))))))
|
||||
(and (<= (vector-length part) (- end start))
|
||||
(let loop ((i 0) (j start))
|
||||
(match (and (< i (vector-length part)) (vector-ref part i))
|
||||
(#f #t)
|
||||
((? char? chr)
|
||||
(and (char=? (string-ref s j) chr)
|
||||
(loop (1+ i) (1+ j))))
|
||||
((? char-set? cs)
|
||||
(and (char-set-contains? cs (string-ref s j))
|
||||
(loop (1+ i) (1+ j))))))))
|
||||
|
||||
(define* (string-ends-with-part s part #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
(let ((start* (- end (pattern-part-length part))))
|
||||
(let ((start* (- end (vector-length part))))
|
||||
(and (>= start* start)
|
||||
(string-starts-with-part s part start* end))))
|
||||
|
||||
(define* (string-contains-part s part #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
(let loop ((part part) (i start))
|
||||
(match part
|
||||
(() (cons start (- i start)))
|
||||
(('? . rest) (loop rest (1+ i)))
|
||||
(((? string? s2) . rest)
|
||||
(and=> (string-contains s s2 i end)
|
||||
(lambda (index)
|
||||
(or (and=> (string-starts-with-part s part index end)
|
||||
(cut cons index <>))
|
||||
(loop part (1+ index))))))
|
||||
(((or (? char? cp) (? char-set? cp)) . rest)
|
||||
(and=> (string-index s cp i end)
|
||||
(lambda (index)
|
||||
(or (and=> (string-starts-with-part s part index end)
|
||||
(cut cons index <>))
|
||||
(loop part (1+ index)))))))))
|
||||
(let loop ((i start))
|
||||
(cond
|
||||
((>= i end) #f)
|
||||
((string-starts-with-part s part i end) i)
|
||||
(else (loop (1+ i))))))
|
||||
|
||||
(define* (string-contains-part-right s part #:optional (start 0)
|
||||
(end (string-length s)))
|
||||
(let loop ((i end))
|
||||
(cond
|
||||
((< i start) #f)
|
||||
((string-ends-with-part s part start i) (- i (vector-length part)))
|
||||
(else (loop (1- i))))))
|
||||
|
||||
(define* (pattern-match? pattern str #:optional (start 0)
|
||||
(end (string-length str))
|
||||
#:key explicit-initial-period?)
|
||||
"Check if @var{str} matches @var{pattern}."
|
||||
(if (and explicit-initial-period?
|
||||
(< start end)
|
||||
(char=? (string-ref str start) #\.))
|
||||
(match pattern
|
||||
(((#\. . _) . _)
|
||||
(pattern-match? pattern str start end
|
||||
#:explicit-initial-period? #f))
|
||||
((((? string? s) . _) ._)
|
||||
(and (string-prefix? "." s)
|
||||
(pattern-match? pattern str start end
|
||||
#:explicit-initial-period? #f)))
|
||||
(_ #f))
|
||||
(let loop ((pattern pattern) (i start))
|
||||
(match pattern
|
||||
(() (= i end))
|
||||
(('*) #t)
|
||||
(('* (? pair? part)) (string-ends-with-part str part i end))
|
||||
(('* (? pair? part) . rest)
|
||||
(and=> (string-contains-part str part i end)
|
||||
(match-lambda
|
||||
((match-index . match-length)
|
||||
(loop rest (+ match-index match-length))))))
|
||||
(((? pair? part) . rest)
|
||||
(and=> (string-starts-with-part str part i end)
|
||||
(lambda (length)
|
||||
(loop rest (+ i length)))))))))
|
||||
|
||||
(define (parts-match? parts start)
|
||||
(match parts
|
||||
(() (= start end))
|
||||
((part) (string-ends-with-part str part start end))
|
||||
((part . rest)
|
||||
(and=> (string-contains-part str part start end)
|
||||
(lambda (m)
|
||||
(let ((start* (+ m (vector-length part))))
|
||||
(parts-match? rest start*)))))))
|
||||
|
||||
(match-let ((($ <pattern> parts) pattern))
|
||||
(if (and explicit-initial-period?
|
||||
(< start end)
|
||||
(char=? (string-ref str start) #\.))
|
||||
(match parts
|
||||
((#(#\. _ ...) . _)
|
||||
(pattern-match? pattern str start end
|
||||
#:explicit-initial-period? #f))
|
||||
(_ #f))
|
||||
(match parts
|
||||
(() (= start end))
|
||||
((part . rest)
|
||||
(and (string-starts-with-part str part start end)
|
||||
(let ((start* (+ start (vector-length part))))
|
||||
(parts-match? rest start*))))))))
|
||||
|
||||
(define* (pattern-drop pattern str #:key greedy?)
|
||||
(define (match-parts parts i)
|
||||
(match parts
|
||||
(() (substring str i))
|
||||
((part . rest)
|
||||
(match (if (and greedy? (null? rest))
|
||||
(string-contains-part-right str part i)
|
||||
(string-contains-part str part i))
|
||||
(#f str)
|
||||
(m (match-parts rest (+ m (vector-length part))))))))
|
||||
|
||||
(match-let ((($ <pattern> parts) pattern))
|
||||
(match parts
|
||||
(() str)
|
||||
((part . rest)
|
||||
(if (string-starts-with-part str part)
|
||||
(match-parts rest (vector-length part))
|
||||
str)))))
|
||||
|
||||
(define* (pattern-drop-right pattern str #:key greedy?)
|
||||
(define (match-parts parts i)
|
||||
(match parts
|
||||
(() (substring str 0 i))
|
||||
((part . rest)
|
||||
(match (if (and greedy? (null? rest))
|
||||
(string-contains-part str part 0 i)
|
||||
(string-contains-part-right str part 0 i))
|
||||
(#f str)
|
||||
(m (match-parts rest m))))))
|
||||
|
||||
(match-let ((($ <pattern> parts) pattern))
|
||||
(let ((strap (reverse parts)))
|
||||
(match strap
|
||||
(() str)
|
||||
((part . rest)
|
||||
(if (string-ends-with-part str part)
|
||||
(let ((i (- (string-length str) (vector-length part))))
|
||||
(match-parts rest i))
|
||||
str))))))
|
||||
|
|
|
@ -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))))))
|
||||
|
|
194
gash/shell.scm
194
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.
|
||||
;;;
|
||||
|
@ -18,6 +18,7 @@
|
|||
|
||||
(define-module (gash shell)
|
||||
#:use-module (gash built-ins)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash compat textual-ports)
|
||||
#:use-module (gash environment)
|
||||
#:use-module (gash pattern)
|
||||
|
@ -25,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
|
||||
|
@ -55,7 +57,7 @@
|
|||
(define (errexit)
|
||||
(unless (or (zero? (get-status)) (ignore-errexit?))
|
||||
(when (getopt 'errexit)
|
||||
(exit (get-status)))))
|
||||
(sh:exit))))
|
||||
|
||||
(define (install-current-ports!)
|
||||
"Install all current ports into their usual file descriptors. For
|
||||
|
@ -130,20 +132,30 @@ environment variable bindings @var{bindings}."
|
|||
((name . value)
|
||||
(setvar! name value)))
|
||||
bindings)
|
||||
(let ((exit-val (apply proc args)))
|
||||
(set-status! exit-val))))
|
||||
(set-status! (apply proc args))))
|
||||
(and=> (getfun name)
|
||||
(lambda (proc)
|
||||
(with-arguments (cons (car (program-arguments)) args)
|
||||
(save-variables-excursion (map car bindings)
|
||||
(lambda ()
|
||||
(call-with-return
|
||||
(lambda ()
|
||||
(apply proc args)))))))
|
||||
(for-each (match-lambda
|
||||
((name . value)
|
||||
(setvar! name value)))
|
||||
bindings)
|
||||
(with-arguments (cons (car (program-arguments)) args)
|
||||
(lambda ()
|
||||
(call-with-return
|
||||
(lambda ()
|
||||
(apply proc args)))))))))
|
||||
(and=> (search-built-ins name)
|
||||
(lambda (proc)
|
||||
;; TODO: Use 'bindings' here.
|
||||
(let ((exit-val (apply proc args)))
|
||||
(set-status! exit-val))))
|
||||
(save-variables-excursion (map car bindings)
|
||||
(lambda ()
|
||||
(for-each (match-lambda
|
||||
((name . value)
|
||||
(setvar! name value)))
|
||||
bindings)
|
||||
(let ((exit-val (apply proc args)))
|
||||
(set-status! exit-val))))))
|
||||
(and=> (find-utility name)
|
||||
(lambda (path)
|
||||
(exec-utility bindings path name args)))
|
||||
|
@ -161,45 +173,49 @@ environment variable bindings @var{bindings}."
|
|||
|
||||
;;; Redirects.
|
||||
|
||||
(define (redir->parameter+port redir)
|
||||
"Convert @var{redir} into a pair consisting of the current-port
|
||||
parameter to be updated and the port that should be its new value (or
|
||||
@code{#f} if it should be considered closed)."
|
||||
(define (process-redir redir)
|
||||
"Convert @var{redir} into a list consisting of the current-port
|
||||
parameter to be updated, the port that should be its new value (or
|
||||
@code{#f} if it should be considered closed), and a boolean indicating
|
||||
if it is our responsibility to close the port."
|
||||
|
||||
(define* (make-parameter+port fd target #:optional (open-flags 0))
|
||||
(define* (make-processed-redir fd target #:optional (open-flags 0))
|
||||
(let ((port (match target
|
||||
((? port?) target)
|
||||
((? string?) (open target open-flags))
|
||||
;; TODO: Verify open-flags.
|
||||
((? integer?) ((fd->current-port target)))
|
||||
(#f #f))))
|
||||
`(,(fd->current-port fd) . ,port)))
|
||||
`(,(fd->current-port fd) ,port ,(string? target))))
|
||||
|
||||
(match redir
|
||||
(('< (? integer? fd) (? string? filename))
|
||||
(make-parameter+port fd filename O_RDONLY))
|
||||
(make-processed-redir fd filename O_RDONLY))
|
||||
(('> (? integer? fd) (? string? filename))
|
||||
;; TODO: Observe noclobber.
|
||||
(make-parameter+port 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-parameter+port fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
|
||||
(make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
|
||||
(('>> fd filename)
|
||||
(make-parameter+port fd filename (logior O_WRONLY O_CREAT O_APPEND)))
|
||||
(make-processed-redir fd filename (logior O_WRONLY O_CREAT O_APPEND)))
|
||||
(('<> fd filename)
|
||||
(make-parameter+port fd filename (logior O_RDWR O_CREAT)))
|
||||
(make-processed-redir fd filename (logior O_RDWR O_CREAT)))
|
||||
(('<& (? integer? fd1) (? integer? fd2))
|
||||
(make-parameter+port fd1 fd2))
|
||||
(make-processed-redir fd1 fd2))
|
||||
(('<& (? integer? fd) '-)
|
||||
(make-parameter+port fd #f))
|
||||
(make-processed-redir fd #f))
|
||||
(('>& (? integer? fd1) (? integer? fd2))
|
||||
(make-parameter+port fd1 fd2))
|
||||
(make-processed-redir fd1 fd2))
|
||||
(('>& (? integer? fd) '-)
|
||||
(make-parameter+port fd #f))
|
||||
(make-processed-redir fd #f))
|
||||
(('<< (? integer? fd) text)
|
||||
(let ((port (tmpfile)))
|
||||
(display text port)
|
||||
(seek port 0 SEEK_SET)
|
||||
(make-parameter+port fd port)))))
|
||||
(make-processed-redir fd port)))))
|
||||
|
||||
(define (sh:set-redirects redirs)
|
||||
"Put the redirects @var{redirs} into effect."
|
||||
|
@ -207,11 +223,10 @@ parameter to be updated and the port that should be its new value (or
|
|||
(match redirs
|
||||
(() #t)
|
||||
((redir . rest)
|
||||
(match (false-if-exception
|
||||
(redir->parameter+port redir))
|
||||
(match (false-if-exception (process-redir redir))
|
||||
(#f (set-status! 1)
|
||||
(errexit))
|
||||
((parameter . port)
|
||||
((parameter port close?)
|
||||
(parameter port)
|
||||
(loop rest)))))))
|
||||
|
||||
|
@ -222,15 +237,15 @@ parameter to be updated and the port that should be its new value (or
|
|||
;; only way.
|
||||
((fold-right (lambda (redir thunk)
|
||||
(lambda ()
|
||||
(match (false-if-exception
|
||||
(redir->parameter+port redir))
|
||||
(match (false-if-exception (process-redir redir))
|
||||
(#f (set-status! 1)
|
||||
(errexit))
|
||||
((parameter . port)
|
||||
((parameter port close?)
|
||||
(parameterize ((parameter port))
|
||||
(thunk))
|
||||
(when (output-port? port)
|
||||
(force-output port))))))
|
||||
(cond
|
||||
(close? (close-port port))
|
||||
((output-port? port) (force-output port)))))))
|
||||
thunk
|
||||
redirs)))
|
||||
|
||||
|
@ -245,13 +260,20 @@ process."
|
|||
;; duplicate output.
|
||||
(flush-all-ports)
|
||||
(match (primitive-fork)
|
||||
(0 (with-continuation-barrier
|
||||
(lambda ()
|
||||
(restore-signals)
|
||||
(set-atexit! #f)
|
||||
(thunk)
|
||||
(primitive-exit (get-status))))
|
||||
(primitive-exit 1))
|
||||
(0 (dynamic-wind
|
||||
(lambda () #t)
|
||||
(lambda ()
|
||||
(restore-signals)
|
||||
(set-atexit! #f)
|
||||
;; We need to preserve the status given to 'exit', so we
|
||||
;; catch the 'quit' key here.
|
||||
(catch 'quit
|
||||
thunk
|
||||
(lambda (_ status)
|
||||
(primitive-exit status)))
|
||||
(primitive-exit (get-status)))
|
||||
(lambda ()
|
||||
(primitive-exit 1))))
|
||||
(pid pid)))
|
||||
|
||||
(define (sh:subshell thunk)
|
||||
|
@ -279,36 +301,14 @@ a string."
|
|||
|
||||
;;; Pipelines.
|
||||
|
||||
(define (swap-and-shift-pairs pairs)
|
||||
"Swap and shift @var{pairs} over by one. For example, the list
|
||||
@code{((a . b) (c . d))} becomes @code{((#f . b) (a . d) (c . #f))}"
|
||||
(let ((kons (lambda (pair acc)
|
||||
(match-let (((a . b) pair))
|
||||
(match acc
|
||||
((head . rest) `(,b (,a . ,head) ,@rest))
|
||||
(() `(,b (,a . #f))))))))
|
||||
(match (fold-right kons '() pairs)
|
||||
((head . rest) `((#f . ,head) ,@rest))
|
||||
(() '()))))
|
||||
|
||||
(define (make-pipes xs)
|
||||
"Cons each element of @var{xs} to a pair of ports such that the first
|
||||
port is an input port connected to the second port of the previous
|
||||
element's pair, and the second port is an output port connected to the
|
||||
first port of next element's pair. The first pair will have @code{#f}
|
||||
for an input port and the last will have @code{#f} as an output port."
|
||||
(match xs
|
||||
(() '())
|
||||
((x) `((,x . (#f . #f))))
|
||||
(_ (let ((pipes (map (lambda (x) (pipe)) (cdr xs))))
|
||||
(map cons xs (swap-and-shift-pairs pipes))))))
|
||||
|
||||
(define (plumb in out thunk)
|
||||
(define (plumb in out close thunk)
|
||||
"Run @var{thunk} in a new process with @code{current-input-port} set
|
||||
to @var{in} and @code{current-output-port} set to @var{out}. If
|
||||
@var{in} or @var{out} is @code{#f}, the corresponding ``current'' port
|
||||
is left unchanged."
|
||||
is left unchanged. Unless it is @code{#f}, the port @var{close} will
|
||||
be closed in the new process."
|
||||
(let* ((thunk* (lambda ()
|
||||
(when close (close-port close))
|
||||
(let ((in (or in (current-input-port)))
|
||||
(out (or out (current-output-port))))
|
||||
(parameterize ((current-input-port in)
|
||||
|
@ -319,18 +319,49 @@ is left unchanged."
|
|||
(when out (close-port out))
|
||||
pid))
|
||||
|
||||
(define (waitpid/any pids)
|
||||
"Wait for any process with an ID in the list @var{pids} to terminate
|
||||
and return its status information."
|
||||
(let loop ((interval 10))
|
||||
(or (any (lambda (pid)
|
||||
(match (waitpid pid WNOHANG)
|
||||
((0 . _) #f)
|
||||
(x x)))
|
||||
pids)
|
||||
(begin
|
||||
(usleep interval)
|
||||
(loop (if (< interval 160)
|
||||
(* 2 interval)
|
||||
interval))))))
|
||||
|
||||
(define (sh:pipeline . thunks)
|
||||
"Run each thunk in @var{thunks} in its own process with the output
|
||||
of each thunk sent to the input of the next thunk."
|
||||
(let ((pids (map (match-lambda
|
||||
((thunk . (source . sink))
|
||||
(plumb source sink thunk)))
|
||||
(make-pipes thunks))))
|
||||
(define (plumb-thunks)
|
||||
(let loop ((thunks thunks) (in #f) (pids '()))
|
||||
(match thunks
|
||||
(() pids)
|
||||
((thunk) (reverse! (cons (plumb in #f #f thunk) pids)))
|
||||
((thunk . rest)
|
||||
(match-let (((next-in . out) (pipe)))
|
||||
(loop rest next-in (cons (plumb in out next-in thunk) pids)))))))
|
||||
|
||||
(let ((pids (plumb-thunks)))
|
||||
(unless (null? pids)
|
||||
(match-let* ((pid (last pids))
|
||||
((pid . status) (waitpid pid)))
|
||||
(set-status! (status:exit-val status))
|
||||
(errexit)))))
|
||||
(let ((last-pid (last pids)))
|
||||
;; We have to wait for all the processes to finish so we can
|
||||
;; reap them. We do this by polling them with 'waitpid'.
|
||||
;; This is something of a naive approach, but it works for now
|
||||
;; and will be easier to improve later when we have job
|
||||
;; control.
|
||||
(let loop ((pids pids))
|
||||
(unless (null? pids)
|
||||
(match (waitpid/any pids)
|
||||
((pid . status)
|
||||
(when (= pid last-pid)
|
||||
(set-status! (status:exit-val status)))
|
||||
(loop (remove (cut = pid <>) pids)))))))
|
||||
(errexit))))
|
||||
|
||||
|
||||
;;; Boolean expressions.
|
||||
|
@ -411,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)))
|
||||
|
|
180
gash/word.scm
180
gash/word.scm
|
@ -1,5 +1,5 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
|
@ -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 '()))
|
||||
|
@ -112,7 +112,9 @@ in the string @var{ifs}."
|
|||
vals))
|
||||
acc)))
|
||||
(((? string? h) . t)
|
||||
(loop t (cons `(<sh-quote> ,h) acc))))))
|
||||
(loop t (cons `(<sh-quote> ,h) acc)))
|
||||
(((qwords ...) . t)
|
||||
(loop t (append-reverse (wedge-apart-quote qwords) acc))))))
|
||||
|
||||
(define (wedge-apart qword)
|
||||
(match qword
|
||||
|
@ -168,59 +170,76 @@ string, the separator is derived from @var{ifs} using
|
|||
(let ((sep (argument-separator ifs)))
|
||||
(loop t (cons (string-join vals sep) acc))))
|
||||
(((? string? h) . t)
|
||||
(loop t (cons h acc))))))
|
||||
(loop t (cons h acc)))
|
||||
(((qwords ...) . t)
|
||||
(loop t (cons (remove-quotes qwords ifs) acc))))))
|
||||
|
||||
(define (qword->pattern qword ifs)
|
||||
(define (qword->pattern-string qword ifs)
|
||||
(let loop ((qword (normalize-word qword)) (acc '()))
|
||||
(match qword
|
||||
(() (parse-pattern (string-concatenate-reverse acc)))
|
||||
(() (string-concatenate-reverse acc))
|
||||
((('<sh-quote> qword*) . t)
|
||||
(loop t (cons (pattern-quote (remove-quotes qword* ifs)) acc)))
|
||||
(((? string? h) . t)
|
||||
(loop t (cons h acc))))))
|
||||
|
||||
(define (qword->pattern qword ifs)
|
||||
(parse-pattern (qword->pattern-string qword ifs)))
|
||||
|
||||
(define (find-files base patterns)
|
||||
"Find all the files starting from @var{base} where each node of the
|
||||
file's relative path matchs the corresponding pattern in
|
||||
@var{patterns}."
|
||||
(define (make-select pattern)
|
||||
(cut pattern-match? pattern <> #:explicit-initial-period? #t))
|
||||
|
||||
(define (ensure-directory path)
|
||||
(and (scandir (string-append base "/" path))
|
||||
(string-append path "/")))
|
||||
|
||||
(define* (list-directory path pattern)
|
||||
(map (cond
|
||||
((string-null? path) values)
|
||||
((string-every #\/ path) (cut string-append path <>))
|
||||
(else (cut string-append path "/" <>)))
|
||||
(or (scandir (string-append base "/" path) (make-select pattern))
|
||||
'())))
|
||||
|
||||
(let loop ((paths (list "")) (patterns patterns))
|
||||
(match patterns
|
||||
(() paths)
|
||||
(((? pattern-null?) . rest)
|
||||
(loop (filter-map ensure-directory paths) rest))
|
||||
((pattern . rest)
|
||||
(loop (append-map (cut list-directory <> pattern) paths) rest)))))
|
||||
|
||||
(define (expand-pathnames qword pwd ifs)
|
||||
"Interpret @var{qword} as a pattern and find all files matching that
|
||||
pattern. If no files are found, return a singleton list containing a
|
||||
string version of @var{qword}. If the pattern is relative, @var{pwd}
|
||||
will be used as the current directory. If @var{qword} contains
|
||||
preserved fields (e.g., @code{\"$@\"}), @var{ifs} will be used to
|
||||
faltten them."
|
||||
(define absolute?
|
||||
(match-lambda
|
||||
(((? pattern-null?) . _) #t)
|
||||
(_ #f)))
|
||||
|
||||
(define (list-matches patterns)
|
||||
(let loop ((stack `(("" ,@patterns))) (acc '()))
|
||||
(match stack
|
||||
(() (reverse! acc))
|
||||
(((path) . stack-tail)
|
||||
(loop stack-tail (cons path acc)))
|
||||
(((path pattern . next-patterns) . stack-tail)
|
||||
(match (scandir (string-append pwd "/" path)
|
||||
(cut pattern-match? pattern <>
|
||||
#:explicit-initial-period? #t))
|
||||
(#f (loop stack-tail acc))
|
||||
(files (loop (append (map (lambda (file)
|
||||
(if (string-null? path)
|
||||
(cons file next-patterns)
|
||||
(cons (string-append path "/" file)
|
||||
next-patterns)))
|
||||
files)
|
||||
stack-tail)
|
||||
acc)))))))
|
||||
|
||||
(let ((patterns (map (cut qword->pattern <> ifs)
|
||||
(split-fields qword "/"))))
|
||||
(if (every pattern-plain? patterns)
|
||||
`(,(remove-quotes qword ifs))
|
||||
(match (list-matches patterns)
|
||||
(() `(,(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))))
|
||||
(if (getopt 'noglob)
|
||||
`(,(remove-quotes qword ifs))
|
||||
(let* ((pattern-string (qword->pattern-string qword ifs))
|
||||
(patterns (map parse-pattern (string-split pattern-string #\/)))
|
||||
(base (if (absolute? patterns) "/" pwd)))
|
||||
(if (every pattern-plain? patterns)
|
||||
`(,(remove-quotes qword ifs))
|
||||
(match (find-files base patterns)
|
||||
(() `(,(remove-quotes qword ifs)))
|
||||
(matches matches))))))
|
||||
|
||||
(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 @code{#f}."
|
||||
the environment. If @var{name} is unset, return @var{dflt} if
|
||||
provided or @code{#f} if not."
|
||||
(match name
|
||||
("@" `(<sh-at> ,(cdr (program-arguments))))
|
||||
("*" (let* ((ifs (or (getvar "IFS")
|
||||
|
@ -231,6 +250,8 @@ the environment. If @var{name} is unset, return @code{#f}."
|
|||
("#" (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)
|
||||
|
@ -238,71 +259,10 @@ the environment. If @var{name} is unset, return @code{#f}."
|
|||
(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)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<sh-ref-assert*> name message)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<sh-ref-and> name value)
|
||||
(if (string-not-null? (parameter-ref name))
|
||||
(word->qword (or value ""))
|
||||
""))
|
||||
(('<sh-ref-and*> name value)
|
||||
(or (and (parameter-ref name)
|
||||
(word->qword (or value "")))
|
||||
""))
|
||||
(('<sh-ref-except-min> name pattern)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<sh-ref-except-max> name pattern)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<sh-ref-skip-min> name pattern)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<sh-ref-skip-max> name pattern)
|
||||
(error (format #f "Not implemented: ~s" word)))
|
||||
(('<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)
|
||||
|
|
7
guix.scm
7
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
|
||||
|
|
|
@ -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)
|
53
test.sh
53
test.sh
|
@ -1,53 +0,0 @@
|
|||
# Gash --- Guile As SHell
|
||||
# Copyright © 2016, 2017 R.E.W. van Beusekom <rutger.van.beusekom@gmail.com>
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
# Copyright © 2018, 2019 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/>.
|
||||
|
||||
set -e
|
||||
if [ -n "$V" ]; then
|
||||
set -x
|
||||
fi
|
||||
DIFF=${DIFF-diff}
|
||||
TEST_SHELL=${TEST_SHELL-gash}
|
||||
|
||||
t="$1"
|
||||
s=tests/$(basename "$t" .sh)
|
||||
|
||||
# This is a hack to make sure we can build from an external directory.
|
||||
# We move into the source directory, and then send all of our output
|
||||
# back to the build directory.
|
||||
export TEST_TMP=$(pwd)
|
||||
b=$(pwd)/$s
|
||||
cd $(dirname "$t")/..
|
||||
|
||||
set +e
|
||||
timeout 10 $TEST_SHELL -e "$s".sh -s --long file0 file1 > "$b".1 2> "$b".2
|
||||
r=$?
|
||||
set -e
|
||||
if [ -f "$s".exit ]; then
|
||||
e=$(cat "$s".exit)
|
||||
else
|
||||
e=0
|
||||
fi
|
||||
[ $r = $e ] || exit 1
|
||||
if [ -f "$s".stdout ]; then
|
||||
$DIFF -u "$s".stdout "$b".1
|
||||
fi
|
||||
if [ -f "$s".stderr ]; then
|
||||
$DIFF -u "$s".stderr "$b".2
|
||||
fi
|
|
@ -1 +0,0 @@
|
|||
exit 0
|
|
@ -1 +0,0 @@
|
|||
1
|
|
@ -1 +0,0 @@
|
|||
exit 1
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1 +0,0 @@
|
|||
exit 2
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1,2 +0,0 @@
|
|||
set +e
|
||||
ls /foo
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1,3 +0,0 @@
|
|||
set +e
|
||||
ls /foo
|
||||
exit $?
|
|
@ -1 +0,0 @@
|
|||
exit
|
|
@ -1,2 +0,0 @@
|
|||
echo $0
|
||||
|
|
@ -1 +0,0 @@
|
|||
echo $#
|
|
@ -1 +0,0 @@
|
|||
4
|
|
@ -1 +0,0 @@
|
|||
echo $@
|
|
@ -1 +0,0 @@
|
|||
-s --long file0 file1
|
|
@ -1,4 +0,0 @@
|
|||
echo foo\
|
||||
bar baz\
|
||||
bla
|
||||
echo
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1,3 +0,0 @@
|
|||
exit \
|
||||
\
|
||||
2
|
|
@ -1 +0,0 @@
|
|||
0
|
|
@ -1,2 +0,0 @@
|
|||
exit\
|
||||
0
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1,2 +0,0 @@
|
|||
true
|
||||
exit 2
|
|
@ -1 +0,0 @@
|
|||
2
|
|
@ -1 +0,0 @@
|
|||
true; exit 2
|
|
@ -1,9 +0,0 @@
|
|||
echo $@
|
||||
shift
|
||||
echo $@
|
||||
shift
|
||||
echo $@
|
||||
shift
|
||||
echo $@
|
||||
shift
|
||||
echo $@
|
|
@ -1,5 +0,0 @@
|
|||
-s --long file0 file1
|
||||
--long file0 file1
|
||||
file0 file1
|
||||
file1
|
||||
|
|
@ -1 +0,0 @@
|
|||
echo foo:{bar}
|
|
@ -1 +0,0 @@
|
|||
foo:{bar}
|
|
@ -1 +0,0 @@
|
|||
echo "foo" b"ar"
|
|
@ -1 +0,0 @@
|
|||
foo bar
|
|
@ -1 +0,0 @@
|
|||
echo foo "bar" \"baz\"
|
|
@ -1 +0,0 @@
|
|||
foo bar "baz"
|
|
@ -1 +0,0 @@
|
|||
echo 'foo "bar"'
|
|
@ -1 +0,0 @@
|
|||
foo "bar"
|
|
@ -1 +0,0 @@
|
|||
echo foo "bar" '"baz"'
|
|
@ -1 +0,0 @@
|
|||
foo bar "baz"
|
|
@ -1 +0,0 @@
|
|||
echo
|
|
@ -1 +0,0 @@
|
|||
echo a=$a
|
|
@ -1 +0,0 @@
|
|||
a=
|
|
@ -1 +0,0 @@
|
|||
echo $SHELL
|
|
@ -1 +0,0 @@
|
|||
echo command $@ plus
|
|
@ -1 +0,0 @@
|
|||
command -s --long file0 file1 plus
|
|
@ -1 +0,0 @@
|
|||
echo command $@
|
|
@ -1 +0,0 @@
|
|||
command -s --long file0 file1
|
|
@ -1,3 +0,0 @@
|
|||
obj=ar.o
|
||||
objs="$objs `basename $obj`"
|
||||
echo "objs:>$objs<"
|
|
@ -1 +0,0 @@
|
|||
objs:> ar.o<
|
|
@ -1 +0,0 @@
|
|||
srcdir="."
|
|
@ -1,4 +0,0 @@
|
|||
aliaspath=alias
|
||||
localedir=locale
|
||||
defines="-DALIASPATH=\"${aliaspath}\" -DLOCALEDIR=\"${localedir}\""
|
||||
echo cc $defines
|
|
@ -1 +0,0 @@
|
|||
cc -DALIASPATH="alias" -DLOCALEDIR="locale"
|
|
@ -1,2 +0,0 @@
|
|||
SHELL=/bin/bash
|
||||
echo $SHELL
|
|
@ -1 +0,0 @@
|
|||
/bin/bash
|
|
@ -1,2 +0,0 @@
|
|||
a=
|
||||
echo a:$a
|
|
@ -1 +0,0 @@
|
|||
a:
|
|
@ -1 +0,0 @@
|
|||
srcdir='.'
|
|
@ -1,3 +0,0 @@
|
|||
SHELL=gash
|
||||
bin=${SHELL}/bin
|
||||
echo $bin
|
|
@ -1 +0,0 @@
|
|||
gash/bin
|
|
@ -1,3 +0,0 @@
|
|||
SHELL=gash
|
||||
PATH=bin:${SHELL}
|
||||
echo $PATH
|
|
@ -1 +0,0 @@
|
|||
bin:gash
|
|
@ -1 +0,0 @@
|
|||
SHELL=/bin/bash
|
|
@ -1,4 +0,0 @@
|
|||
CC=echo
|
||||
empty=
|
||||
file=ar.o
|
||||
$CC -I${empty} $file
|
|
@ -1 +0,0 @@
|
|||
-I ar.o
|
|
@ -1,2 +0,0 @@
|
|||
srcdir=.
|
||||
echo cc -c ${srcdir}/$file
|
|
@ -1 +0,0 @@
|
|||
cc -c ./
|
|
@ -1,2 +0,0 @@
|
|||
foo=baz
|
||||
echo ${foo-bar}
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue