From 0f5b538c3ab71664f8eaa2d394f1e4162c50d5fc Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 16 Jul 2018 08:41:10 +0200 Subject: [PATCH] geesh: initial integration. GUILE_LOAD_PATH=$HOME/src/geesh:$GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH=$HOME/src/geesh:$GUILE_LOAD_COMPILED_PATH bin/gash --parse -c 'echo boo | sed s,o,O, | grep .' bin/gash --geesh --parse -c 'echo boo | sed s,o,O, | grep .' --- INSTALL | 30 + build-aux/build-guile.sh | 7 +- configure | 9 + gash/bournish-commands.scm | 253 +++++-- gash/builtins.scm | 621 ++++++------------ gash/environment.scm | 4 + gash/gash.scm | 144 +--- gash/geesh.scm | 127 ++++ gash/guix-build-utils.scm | 36 +- gash/job.scm | 12 +- gash/peg.scm | 141 +++- gash/script.scm | 251 +++++++ gash/util.scm | 14 +- test.sh | 5 +- ...05-assignment-doublequoted-doublequotes.sh | 5 + test/06-assignment-singlequote.sh | 1 + test/07-assignment-double-quote.sh | 1 + test/08-assignment-variable-word.sh | 1 + test/09-compound-word.sh | 2 + test/0a-assign-substitute.sh | 2 + test/0b-command-compound-word.sh | 3 + test/10-if.sh | 4 + test/11-if-false.sh | 4 + ...ution.sh => 30-assignment-substitution.sh} | 0 test/30-eval.sh | 1 + test/31-eval-echo-variable.sh | 2 + test/32-for-substitute.sh | 3 + test/35-assignment-eval-echo.sh | 1 + test/assign2.sh | 2 + test/for-split-sequence.sh | 5 + test/for.sh | 3 + test/if.sh | 3 - test/iohere.sh | 1 - 33 files changed, 1029 insertions(+), 669 deletions(-) create mode 100644 INSTALL create mode 100644 gash/geesh.scm create mode 100644 gash/script.scm create mode 100644 test/05-assignment-doublequoted-doublequotes.sh create mode 100644 test/06-assignment-singlequote.sh create mode 100644 test/07-assignment-double-quote.sh create mode 100644 test/08-assignment-variable-word.sh create mode 100644 test/09-compound-word.sh create mode 100644 test/0a-assign-substitute.sh create mode 100644 test/0b-command-compound-word.sh create mode 100644 test/10-if.sh create mode 100644 test/11-if-false.sh rename test/{08-assignment-susbtitution.sh => 30-assignment-substitution.sh} (100%) create mode 100644 test/30-eval.sh create mode 100644 test/31-eval-echo-variable.sh create mode 100644 test/32-for-substitute.sh create mode 100644 test/35-assignment-eval-echo.sh create mode 100644 test/for-split-sequence.sh create mode 100644 test/for.sh delete mode 100644 test/if.sh diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..7835cdc --- /dev/null +++ b/INSTALL @@ -0,0 +1,30 @@ + -*- org -*- +Building and Installing Gash + +* Get it + git clone https://gitlab.com/rutger.van.beusekom/gash + +* Regular build +** Prerequisites +*** Guix + guix environment -l guix.scm + +*** Other GNU/Linux + - [[https://gitlab.com/samplet/geesh][geesh]], 0.1-rc is known to work. + - GNU Guile, version 2.2.3 or is known to work. + - GNU make, version 4.2 known to work. + - SH, /bin/sh, GNU Bash 4.3 is known to work. + - git, 2.10 is known to work. + +** Build it + ./configure + make + +** Check it + make check + +** Install it + make install + +* Guix it + guix package -f guix.scm diff --git a/build-aux/build-guile.sh b/build-aux/build-guile.sh index 5748985..b41d1ca 100755 --- a/build-aux/build-guile.sh +++ b/build-aux/build-guile.sh @@ -27,6 +27,9 @@ export GUILE_AUTO_COMPILE export GUILE_LOAD_PATH export GUILE_LOAD_COMPILED_PATH +GUILE_LOAD_PATH=$HOME/src/geesh:$GUILE_LOAD_PATH +GUILE_LOAD_COMPILED_PATH=$HOME/src/geesh:$GUILE_LOAD_COMPILED_PATH + GUILE_LOAD_PATH=$(pwd):$GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH=$(pwd):$GUILE_LOAD_COMPILED_PATH GUILE=${GUILE-$(command -v guile)} @@ -37,15 +40,17 @@ set -e SCM_FILES=" gash/bournish-commands.scm +gash/guix-build-utils.scm gash/builtins.scm gash/config.scm gash/environment.scm -gash/guix-build-utils.scm +gash/geesh.scm gash/gash.scm gash/io.scm gash/job.scm gash/peg.scm gash/pipe.scm +gash/script.scm gash/util.scm " diff --git a/configure b/configure index f23d4ca..35be694 100755 --- a/configure +++ b/configure @@ -18,6 +18,15 @@ GUILE_SITE_DIR=$PREFIX/share/guile/site/$GUILE_EFFECTIVE_VERSION GUILE_SITE_CCACHE_DIR=$PREFIX/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache GUILE_EFFECTIVE_VERSION=$(guile -c '(display (effective-version))') MAKEINFO=$(command -v makeinfo) +GEESH_PREFIX=${GEESH_PREFIX-$HOME/src/geesh} +if [ -d $GEESH_PREFIX ]; then + GUILE_LOAD_PATH=$GEESH_PREFIX:$GUILE_LOAD_PATH + GUILE_LOAD_COMPILED_PATH=$GEESH_PREFIX:$GUILE_LOAD_COMPILED_PATH + if ! $GUILE -c '(use-modules (geesh parser)) (exit (defined? '"'"'read-sh-all))'; then + echo "your geesh is too old" + exit 1 + fi +fi sed \ -e s,@GUILE@,$GUILE,\ diff --git a/gash/bournish-commands.scm b/gash/bournish-commands.scm index 953e882..b158e28 100644 --- a/gash/bournish-commands.scm +++ b/gash/bournish-commands.scm @@ -33,15 +33,19 @@ #:use-module (gash guix-build-utils) #:use-module (gash config) #:use-module (gash io) + #:use-module (gash util) + #:export ( - display-tabulated + %bournish-commands cat-command + display-tabulated + find-command + grep-command ls-command reboot-command rm-command wc-command which-command - wrap-command )) ;;; Commentary: @@ -105,24 +109,21 @@ TERMINAL-WIDTH. Use COLUMN-GAP spaces between two subsequent columns." (module-define! (resolve-module '(ice-9 getopt-long)) 'short-opt-rx (make-regexp "^-([a-zA-Z0-9]+)(.*)"))) (else)) -(define ls-command-implementation +(define (ls-command-implementation . args) ;; Run-time support procedure. - (case-lambda - (() - (display-tabulated (scandir "."))) - (args - (let* ((option-spec - '((all (single-char #\a)) - (help) - (one-file-per-line (single-char #\1)) - (version))) - (options (getopt-long (cons "ls" args) option-spec)) - (all? (option-ref options 'all #f)) - (help? (option-ref options 'help #f)) - (one-file-per-line? (option-ref options 'one-file-per-line #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '()))) - (cond (help? (display "Usage: ls [OPTION]... [FILE]... + (lambda _ + (let* ((option-spec + '((all (single-char #\a)) + (help) + (one-file-per-line (single-char #\1)) + (version))) + (options (getopt-long (cons "ls" args) option-spec)) + (all? (option-ref options 'all #f)) + (help? (option-ref options 'help #f)) + (one-file-per-line? (option-ref options 'one-file-per-line #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '()))) + (cond (help? (display "Usage: ls [OPTION]... [FILE]... Options: -a, --all do not ignore entries starting with . @@ -130,60 +131,62 @@ Options: --help display this help and exit --version display version information and exit ")) - (version? (format #t "ls (GASH) ~a\n" %version)) - (else - (let* ((files (if (null? files) (scandir ".") - (append-map (lambda (file) - (catch 'system-error - (lambda () - (match (stat:type (lstat file)) - ('directory - ;; Like GNU ls, list the contents of - ;; FILE rather than FILE itself. - (match (scandir file - (match-lambda - ((or "." "..") #f) - (_ #t))) - (#f - (list file)) - ((files ...) - (map (cut string-append file "/" <>) - files)))) - (_ - (list file)))) - (lambda args - (let ((errno (system-error-errno args))) - (format (current-error-port) "~a: ~a~%" - file (strerror errno)) - '())))) - files))) - (files (if all? files - (filter (negate (cut string-prefix? "." <>)) files)))) - (if one-file-per-line? (for-each stdout files) - (display-tabulated files))))))))) + (version? (format #t "ls (GASH) ~a\n" %version)) + (else + (let* ((files (if (null? files) (scandir ".") + (append-map (lambda (file) + (catch 'system-error + (lambda () + (match (stat:type (lstat file)) + ('directory + ;; Like GNU ls, list the contents of + ;; FILE rather than FILE itself. + (match (scandir file + (match-lambda + ((or "." "..") #f) + (_ #t))) + (#f + (list file)) + ((files ...) + (map (cut string-append file "/" <>) + files)))) + (_ + (list file)))) + (lambda args + (let ((errno (system-error-errno args))) + (format (current-error-port) "~a: ~a~%" + file (strerror errno)) + '())))) + files))) + (files (if all? files + (filter (negate (cut string-prefix? "." <>)) files)))) + (if one-file-per-line? (for-each stdout files) + (display-tabulated files)))))))) (define ls-command (wrap-command ls-command-implementation "ls")) (define (which-command program . rest) - (stdout (search-path (executable-path) program))) + (lambda _ + (stdout (search-path (executable-path) program)))) (define (cat-command-implementation . args) - (fold (lambda (file p) - (if (string=? file "-") (dump-port (current-input-port) (current-output-port)) - (call-with-input-file file - (lambda (port) - (dump-port port (current-output-port)))))) - 0 args)) + (lambda _ + (fold (lambda (file p) + (if (string=? file "-") (dump-port (current-input-port) (current-output-port)) + (call-with-input-file file + (lambda (port) + (dump-port port (current-output-port)))))) + 0 args))) (define cat-command (wrap-command cat-command-implementation "cat")) (define (rm-command-implementation . args) - "Emit code for the 'rm' command." - (cond ((member "-r" args) - (for-each delete-file-recursively - (apply delete (cons "-r" args)))) - (else - (for-each delete-file args)))) + (lambda _ + (cond ((member "-r" args) + (for-each delete-file-recursively + (apply delete (cons "-r" args)))) + (else + (for-each delete-file args))))) (define rm-command (wrap-command rm-command-implementation "rm")) @@ -235,12 +238,13 @@ Options: (define (wc-command . args) "Emit code for the 'wc' command." - (cond ((member "-l" args) - (apply wc-l-command-implementation (delete "-l" args))) - ((member "-c" args) - (apply wc-c-command-implementation (delete "-c" args))) - (else - (apply wc-command-implementation args)))) + (lambda _ + (cond ((member "-l" args) + (apply wc-l-command-implementation (delete "-l" args))) + ((member "-c" args) + (apply wc-c-command-implementation (delete "-c" args))) + (else + (apply wc-command-implementation args))))) (define (reboot-command . args) "Emit code for 'reboot'." @@ -259,3 +263,114 @@ Options: (match (getenv "PATH") (#f '()) (str (string-tokenize str %not-colon)))) + +(define (cp-command-implementation source dest . rest) + (lambda _ (copy-file source dest))) + +(define cp-command (wrap-command cp-command-implementation "cp")) + +(define (find-command-implementation . args) + ;; Run-time support procedure. + (lambda _ + (let* ((option-spec + '((help) + (version))) + (options (getopt-long (cons "find" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '())) + (files (if (null? files) '(".") files)) + (file (car files))) + (when (> (length files) 1) + (format (current-error-port) "find: too many FILEs: ~s\n" files) + (error "find failed")) + ;; TODO: find [OPTION]... [FILE]... [EXPRESSION]... + ;; and options: esp: -x, -L + (cond (help? (display "Usage: find [OPTION]... [FILE] + +Options: + --help display this help and exit + --version display version information and exit +")) + (version? (format #t "find (GASH) ~a\n" %version)) + (else + (let* ((files (find-files file #:directories? #t #:fail-on-error? #t))) + (for-each stdout files))))))) + +(define find-command (wrap-command find-command-implementation "find")) + +(define (grep-command . args) + (lambda _ + (let* ((option-spec + '((help) + (line-number (single-char #\n)) + (files-with-matches (single-char #\l)) + (files-without-match (single-char #\L)) + (with-file-name (single-char #\H)) + (no-file-name (single-char #\h)) + (only-matching (single-char #\o)) + (version (single-char #\V)))) + (options (getopt-long (cons "ls" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '()))) + (cond (help? (display "Usage: grep [OPTION]... PATTERN [FILE]... + +Options: + --help display this help and exit + -h, --no-filename suppress the file name prefix on output + -H, --with-filename print file name with output lines + -l, --files-with-matches print only names of FILEs with selected lines + -L, --files-without-match print only names of FILEs with no selected lines + -n, --line-number print line number with output lines + -o, --only-matching show only the part of a line matching PATTERN + -V, --version display version information and exit +")) + (version? (format #t "grep (GASH) ~a\n" %version)) + ((null? files) #t) + (else + (let* ((pattern (car files)) + (files (if (pair? (cdr files)) (cdr files) + (list "-"))) + (matches (append-map (cut grep pattern <>) files))) + (define (display-match o) + (let* ((s (grep-match-string o)) + (s (if (option-ref options 'only-matching #f) + (substring s (grep-match-column o) (grep-match-end-column o)) + s)) + (s (if (option-ref options 'line-number #f) + (string-append (number->string (grep-match-line o)) ":" s) + s)) + (s (if (option-ref options 'with-file-name #f) + (string-append (grep-match-file-name o) ":" s) + s))) + (stdout s))) + (define (files-with-matches) + (delete-duplicates (map grep-match-file-name matches))) + (cond ((option-ref options 'files-with-matches #f) + (let ((result (files-with-matches))) + (and (pair? result) + (for-each stdout result) + 0))) + ((option-ref options 'files-without-match #f) + (let* ((result (files-with-matches)) + (result (filter (negate (cut member <> result)) files))) + (and (pair? result) + (for-each stdout result) + 0))) + (else + (and (pair? matches) + (for-each display-match matches) + 0))))))))) + +(define %bournish-commands + `( + ("cat" . ,cat-command) + ("cp" . ,cp-command) + ("find" . ,find-command) + ("grep" . ,grep-command) + ("ls" . ,ls-command) + ("reboot" . ,reboot-command) + ("wc" . ,wc-command) + ("which" . ,which-command) + )) diff --git a/gash/builtins.scm b/gash/builtins.scm index b1f0bc5..44c740e 100644 --- a/gash/builtins.scm +++ b/gash/builtins.scm @@ -28,60 +28,54 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:use-module (gash bournish-commands) #:use-module (gash config) + #:use-module (gash gash) ; %prefer-builtins? + #:use-module (gash bournish-commands) #:use-module (gash environment) - #:use-module (gash gash) #:use-module (gash guix-build-utils) #:use-module (gash io) #:use-module (gash job) #:use-module (gash pipe) + #:use-module (gash script) #:use-module (gash util) #:export ( %builtin-commands - builtin - pipeline - command - glob - singlequotes - doublequotes - sequence - splice - for - split - substitution - script - if-clause - xtrace - word + PATH-search-path + trace bg-command cd-command echo-command + eval-command exit-command fg-command - find-command help-command + jobs-command pwd-command set-command )) +(define (PATH-search-path program) + (search-path (string-split (getenv "PATH") #\:) program)) + (define (cd-command . args) (match args (() (cd-command (getenv "HOME"))) ((dir) - (assignment "OLDPWD" (getcwd)) - (if (string=? dir "-") (chdir (variable "OLDPWD")) - (chdir dir))) + (let ((old (variable "OLDPWD"))) + (assignment "OLDPWD" (getcwd)) + (if (string=? dir "-") (chdir old) + (chdir dir)))) ((args ...) (format (current-error-port) "cd: too many arguments: ~a\n" (string-join args))))) (define (echo-command . args) - (match args - (() (newline)) - (("-n" args ...) (display (string-join args))) - (_ (display (string-join args)) (newline)))) + (lambda _ + (match args + (() (newline)) + (("-n" args ...) (display (string-join args))) + (_ (display (string-join args)) (newline))))) (define (bg-command . args) (match args @@ -93,18 +87,34 @@ (() (fg 1)) ((job x ...) (fg (string->number (car job)))))) -(define pwd-command (lambda _ (stdout (getcwd)))) +(define (jobs-command) + (format (current-error-port) "jobs: ~s\n" job-table) + (for-each (lambda (job) (display-job job)) (reverse job-table))) + +(define (pwd-command . _) + (lambda _ (stdout (getcwd)))) (define (set-command . args) ;; TODO export; env vs set (define (display-var o) (format #t "~a=~a\n" (car o) (cdr o))) (match args - (() (for-each display-var global-variables)) + (() (lambda _ (for-each display-var %global-variables))) (("-e") (set-shell-opt! "errexit" #t)) (("+e") (set-shell-opt! "errexit" #f)) (("-x") (set-shell-opt! "xtrace" #t)) (("+x") (set-shell-opt! "xtrace" #f)))) +(define (eval-command . args) + (lambda _ + (match args + (() #t) + ((args ...) + (let ((ast (parse-string (string-join args)))) + ;;(ignore-error (run ast)) + (run ast) + (assignment "?" "0") + #t))))) + (define (exit-command . args) (match args (() (exit 0)) @@ -114,68 +124,34 @@ (format (current-error-port) "exit: too many arguments: ~a\n" (string-join args))))) (define (help-command . _) - (display "\ + (lambda _ + (display "\ Hello, this is GASH, Guile As SHell. GASH is work in progress; many language constructs work, globbing mostly works, pipes work, some redirections work. ") - (when (or %prefer-builtins? (not (PATH-search-path "ls"))) - (display "\nIt features the following, somewhat naive builtin commands\n") - (display-tabulated (map car %builtin-commands)))) - -(define (cp-command-implementation source dest . rest) - (copy-file source dest)) - -(define cp-command (wrap-command cp-command-implementation "cp")) - -(define find-command-implementation - ;; Run-time support procedure. - (case-lambda - (() - (find-command-implementation ".")) - (args - (let* ((option-spec - '((help) - (version))) - (options (getopt-long (cons "find" args) option-spec)) - (help? (option-ref options 'help #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '())) - (files (if (null? files) '(".") files)) - (file (car files))) - (when (> (length files) 1) - (format (current-error-port) "find: too many FILEs: ~s\n" files) - (error "find failed")) - ;; TODO: find [OPTION]... [FILE]... [EXPRESSION]... - ;; and options: esp: -x, -L - (cond (help? (display "Usage: find [OPTION]... [FILE] - -Options: - --help display this help and exit - --version display version information and exit -")) - (version? (format #t "find (GASH) ~a\n" %version)) - (else - (let* ((files (find-files file #:directories? #t #:fail-on-error? #t))) - (for-each stdout files)))))))) - -(define find-command (wrap-command find-command-implementation "find")) + (display "\nIt has these builtin commands:\n") + (display-tabulated (map car %builtin-commands)) + (when (or %prefer-builtins? (not (PATH-search-path "ls"))) + (display "\nand features the following, somewhat naive, bournish commands:\n") + (display-tabulated (map car %bournish-commands))))) (define command-command (case-lambda (() #t) (args - (let* ((option-spec - '((describe (single-char #\V)) - (help) - (show (single-char #\v)) - (version))) - (options (getopt-long (cons "command" args) option-spec)) - (help? (option-ref options 'help #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '()))) - (cond (help? (display "Usage: command [OPTION]... [COMMAND [ARG]...] + (lambda _ + (let* ((option-spec + '((describe (single-char #\V)) + (help) + (show (single-char #\v)) + (version))) + (options (getopt-long (cons "command" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '()))) + (cond (help? (display "Usage: command [OPTION]... [COMMAND [ARG]...] Options: --help display this help and exit @@ -183,93 +159,95 @@ Options: -v display a description of COMMAND similar to the `type' builtin -V display a more verbose description of COMMAND ")) - (version? (format #t "command (GASH) ~a\n" %version)) - ((null? files) #t) - ((option-ref options 'describe #f) - (let* ((command (car files)) - (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) - (cond (builtin (format #t "~a is a shell builtin\n" command) - 0) - (else (let ((program (PATH-search-path command))) - (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0) - 1)))))) - ((option-ref options 'show #f) - (let* ((command (car files)) - (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) - (if builtin (begin (stdout command) 0) - (let ((program (PATH-search-path command))) - (if (string? program) (begin (stdout program) 0) - 1))))) - (else (let* ((command (car files)) - (builtin (builtin command #:prefer-builtin? %prefer-builtins?))) - ;; FIXME: - `(command ,@args)))))))) + (version? (format #t "command (GASH) ~a\n" %version)) + ((null? files) #t) + ((option-ref options 'describe #f) + (let* ((command (car files)) + (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) + (cond (builtin (format #t "~a is a shell builtin\n" command) + 0) + (else (let ((program (PATH-search-path command))) + (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0) + 1)))))) + ((option-ref options 'show #f) + (let* ((command (car files)) + (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) + (if builtin (begin (stdout command) 0) + (let ((program (PATH-search-path command))) + (if (string? program) (begin (stdout program) 0) + 1))))) + (else (let* ((command (car files)) + (builtin (builtin command #:prefer-builtin? %prefer-builtins?))) + ;; FIXME: + `(command ,@args))))))))) (define type-command (case-lambda (() #t) (args - (let* ((option-spec - '((help) - (canonical-file-name (single-char #\p)) - (version))) - (options (getopt-long (cons "type" args) option-spec)) - (help? (option-ref options 'help #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '()))) - (cond (help? (display "Usage: type [OPTION]... [COMMAND] + (lambda _ + (let* ((option-spec + '((help) + (canonical-file-name (single-char #\p)) + (version))) + (options (getopt-long (cons "type" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '()))) + (cond (help? (display "Usage: type [OPTION]... [COMMAND] Options: --help display this help and exit -p display canonical file name of COMMAND --version display version information and exit ")) - (version? (format #t "type (GASH) ~a\n" %version)) - ((null? files) #t) - ((option-ref options 'canonical-file-name #f) - (let* ((command (car files)) - (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) - (if builtin 0 - (let ((program (PATH-search-path command))) - (and (string? program) - (stdout program) - 0))))) - (else - (let* ((command (car files)) - (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) - (cond (builtin (format #t "~a is a shell builtin\n" command) - 0) - (else (let ((program (PATH-search-path command))) - (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0) - 1))))))))))) + (version? (format #t "type (GASH) ~a\n" %version)) + ((null? files) #t) + ((option-ref options 'canonical-file-name #f) + (let* ((command (car files)) + (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) + (if builtin 0 + (let ((program (PATH-search-path command))) + (and (string? program) + (stdout program) + 0))))) + (else + (let* ((command (car files)) + (builtin (builtin `(,command) #:prefer-builtin? %prefer-builtins?))) + (cond (builtin (format #t "~a is a shell builtin\n" command) + 0) + (else (let ((program (PATH-search-path command))) + (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0) + 1)))))))))))) (define test-command (case-lambda (() #f) (args - (let* ((option-spec - '((is-directory (single-char #\d)) - (exists (single-char #\e)) - (has-size (single-char #\s)) - (help) - (is-directory (single-char #\d)) - (is-file (single-char #\f)) - (is-symbolic-link (single-char #\L)) - (is-symbolic-link (single-char #\h)) - (is-readable (single-char #\r)) - (is-writable (single-char #\w)) - (is-exeutable (single-char #\x)) - (string-not-null (single-char #\n)) - (string-null (single-char #\z)) - (version))) - (options (getopt-long (cons "test" args) option-spec)) - (help? (option-ref options 'help #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '())) - (file (and (pair? files) (car files))) - (no-options? (and file - (= (length options) 1)))) - (cond (help? (display "Usage: test [EXPRESSION] + (lambda _ + (let* ((option-spec + '((is-directory (single-char #\d)) + (exists (single-char #\e)) + (has-size (single-char #\s)) + (help) + (is-directory (single-char #\d)) + (is-file (single-char #\f)) + (is-symbolic-link (single-char #\L)) + (is-symbolic-link (single-char #\h)) + (is-readable (single-char #\r)) + (is-writable (single-char #\w)) + (is-exeutable (single-char #\x)) + (string-not-null (single-char #\n)) + (string-null (single-char #\z)) + (version))) + (options (getopt-long (cons "test" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '())) + (file (and (pair? files) (car files))) + (no-options? (and file + (= (length options) 1)))) + (cond (help? (display "Usage: test [EXPRESSION] Expression: @@ -297,310 +275,87 @@ Options: --help display this help and exit --version display version information and exit ")) - (version? (format #t "test (GASH) ~a\n" %version)) - ((null? files) #f) - ((or (option-ref options 'n #f) - no-options?) - (not (string-null? file))) - ((option-ref options 'z #f) - (string-null? file)) - ((and (= (length files) 3) - (member (cadr files) '("=" "=="))) - (match files - ((or (left "=" right) - (left "==" right)) - (equal? left right)) - ((left "!=" right) - (not (equal? left right))) - (expression - (pipeline (command expression))))) - ((not (= (length files) 1)) - (format (current-error-port) "test: too many files: ~a\n" files) - 1) - ((option-ref options 'is-file #f) - (regular-file? file)) - ((option-ref options 'is-directory #f) - (directory-exists? file)) - ((option-ref options 'exists #f) - (file-exists? file)) - ((option-ref options 'is-symbolic-link #f) - (symbolic-link? file)) - ((option-ref options 'is-readable #f) - (access? file R_OK)) - ((option-ref options 'has-size #f) - (and (file-exists? file) - (not (zero? (stat:size (stat file)))))) - ((option-ref options 'is-writable #f) - (access? file W_OK)) - ((option-ref options 'is-exeutable #f) - (access? file X_OK)) - (else - (error "gash: test: not supported" args))))))) + (version? (format #t "test (GASH) ~a\n" %version)) + ((null? files) #f) + ((or (option-ref options 'n #f) + no-options?) + (not (string-null? file))) + ((option-ref options 'z #f) + (string-null? file)) + ((and (= (length files) 3) + (member (cadr files) '("=" "=="))) + (match files + ((or (left "=" right) + (left "==" right)) + (equal? left right)) + ((left "!=" right) + (not (equal? left right))) + (expression + (pipeline (command expression))))) + ((not (= (length files) 1)) + (format (current-error-port) "test: too many files: ~a\n" files) + 1) + ((option-ref options 'is-file #f) + (regular-file? file)) + ((option-ref options 'is-directory #f) + (directory-exists? file)) + ((option-ref options 'exists #f) + (file-exists? file)) + ((option-ref options 'is-symbolic-link #f) + (symbolic-link? file)) + ((option-ref options 'is-readable #f) + (access? file R_OK)) + ((option-ref options 'has-size #f) + (and (file-exists? file) + (not (zero? (stat:size (stat file)))))) + ((option-ref options 'is-writable #f) + (access? file W_OK)) + ((option-ref options 'is-exeutable #f) + (access? file X_OK)) + (else + (error "gash: test: not supported" args)))))))) (define bracket-command (case-lambda (() #f) (args - (cond ((and (pair? args) (equal? (car args) "--help")) - (test-command "--help")) - ((and (pair? args) (equal? (car args) "--version")) - (test-command "--version")) - (else - (if (not (equal? (last args) "]")) (begin - (format (current-error-port) "gash: [: missing `]'\n") - #f) - (apply test-command (drop-right args 1)))))))) - -(define grep-command - (case-lambda - (() #f) - (args - (let* ((option-spec - '((help) - (line-number (single-char #\n)) - (files-with-matches (single-char #\l)) - (files-without-match (single-char #\L)) - (with-file-name (single-char #\H)) - (no-file-name (single-char #\h)) - (only-matching (single-char #\o)) - (version (single-char #\V)))) - (options (getopt-long (cons "ls" args) option-spec)) - (help? (option-ref options 'help #f)) - (version? (option-ref options 'version #f)) - (files (option-ref options '() '()))) - (cond (help? (display "Usage: grep [OPTION]... PATTERN [FILE]... - -Options: - --help display this help and exit - -h, --no-filename suppress the file name prefix on output - -H, --with-filename print file name with output lines - -l, --files-with-matches print only names of FILEs with selected lines - -L, --files-without-match print only names of FILEs with no selected lines - -n, --line-number print line number with output lines - -o, --only-matching show only the part of a line matching PATTERN - -V, --version display version information and exit -")) - (version? (format #t "grep (GASH) ~a\n" %version)) - ((null? files) #t) + (lambda _ + (cond ((and (pair? args) (equal? (car args) "--help")) + (test-command "--help")) + ((and (pair? args) (equal? (car args) "--version")) + (test-command "--version")) (else - (let* ((pattern (car files)) - (files (cdr files)) - (matches (append-map (cut grep pattern <>) files))) - (define (display-match o) - (let* ((s (grep-match-string o)) - (s (if (option-ref options 'only-matching #f) - (substring s (grep-match-column o) (grep-match-end-column o)) - s)) - (s (if (option-ref options 'line-number #f) - (string-append (number->string (grep-match-line o)) ":" s) - s)) - (s (if (option-ref options 'with-file-name #f) - (string-append (grep-match-file-name o) ":" s) - s))) - (stdout s))) - (define (files-with-matches) - (delete-duplicates (map grep-match-file-name matches))) - (cond ((option-ref options 'files-with-matches #f) - (let ((result (files-with-matches))) - (and (pair? result) - (for-each stdout result) - 0))) - ((option-ref options 'files-without-match #f) - (let* ((result (files-with-matches)) - (result (filter (negate (cut member <> result)) files))) - (and (pair? result) - (for-each stdout result) - 0))) - (else - (and (pair? matches) - (for-each display-match matches) - 0)))))))))) + (if (not (equal? (last args) "]")) (begin + (format (current-error-port) "gash: [: missing `]'\n") + #f) + (apply test-command (drop-right args 1))))))))) -(define (PATH-search-path program) - (search-path (string-split (getenv "PATH") #\:) program)) - -(define* (builtin ast #:key prefer-builtin?) - ;; FIXME: distinguish between POSIX compliant builtins and - ;; `best-effort'/`fallback'? - "Possibly modify command to use a builtin." - (when (> %debug-level 0) - (format (current-error-port) "builtin ast=~s\n" ast)) - (receive (command args) - (match ast - (((and (? string?) command) args ...) (values command args)) - (_ (values #f #f))) - (let ((program (and command - (cond ((string-prefix? "/" command) - (when (not (file-exists? command)) - (format (current-error-port) "gash: ~a: no such file or directory\n" command)) - command) - (else (PATH-search-path command)))))) - ;; FIXME: find some generic strerror/errno way: what about permissions and stuff? - ;; after calling system* we're too late for that? - (when (> %debug-level 0) - (format (current-error-port) "command ~a => ~s ~s\n" (or program 'builtin) command args)) - (cond ((and program (not prefer-builtin?)) - (when (not program) - (format (current-error-port) "gash: ~a: command not found\n" command)) - (when (not (access? program X_OK)) - (format (current-error-port) "gash: ~a: permission denied\n" command)) - #f) - ((and command (assoc-ref %builtin-commands command)) - => - (lambda (command) - (if args - (apply command (map (cut local-eval <> (the-environment)) args)) - (command)))) - (else #f))))) - -(define (command . args) - (define (exec command) - (cond ((procedure? command) command) - ((every string? command) - (let* ((program (car command)) - (escape-builtin? (and (string? program) (string-prefix? "\\" program))) - (program (if escape-builtin? (string-drop program 1) program)) - (command (cons program (cdr command)))) - (or (builtin command #:prefer-builtin? (and %prefer-builtins? - (not escape-builtin?))) - (cut apply (compose status:exit-val system*) command)))) - (else (lambda () #t)))) - (exec (append-map glob args))) - -(define (glob pattern) - (define (glob? pattern) - (and (string? pattern) (string-match "\\?|\\*" pattern))) - (define (glob2regex pattern) - (let* ((pattern (regexp-substitute/global #f "\\." pattern 'pre "\\." 'post)) - (pattern (regexp-substitute/global #f "\\?" pattern 'pre "." 'post)) - (pattern (regexp-substitute/global #f "\\*" pattern 'pre ".*" 'post))) - (make-regexp (string-append "^" pattern "$")))) - (define (glob-match regex path) ;; pattern path -> bool - (regexp-match? (regexp-exec regex path))) - (define (glob- pattern file-names) - (map (lambda (file-name) - (if (string-prefix? "./" file-name) (string-drop file-name 2) file-name)) - (append-map (lambda (file-name) - (map (cut string-append (if (string=? "/" file-name) "" file-name) "/" <>) - (filter (conjoin (negate (cut string-prefix? "." <>)) - (cute glob-match (glob2regex pattern) <>)) - (or (scandir file-name) '())))) - file-names))) - (cond - ((not pattern) '("")) - ((glob? pattern) (let ((absolute? (string-prefix? "/" pattern))) - (let loop ((patterns (filter (negate string-null?) (string-split pattern #\/))) - (file-names (if absolute? '("/") '(".")))) - (if (null? patterns) - file-names - (begin - (loop (cdr patterns) (glob- (car patterns) file-names))))))) - (#t (list pattern)))) - -(define (singlequotes . o) - (string-join o "")) - -(define (doublequotes . o) - (string-join (append-map glob o) "")) - -(define (sequence . args) - (pke 'sequence (append-map glob (apply append args))) - ;;(pke 'sequence (map glob (pke 'apply-append (apply append (pke 'seq-args: args))))) - ;;(list (apply append args)) - ) - -(define (script . o) - o) - -(define (for name sequence body) - (for-each (lambda (value) - (assignment name value) - (body)) - (sequence))) - -(define (split o) - ((compose string-tokenize string-trim-right) o)) - -(define (xtrace o) - (o)) - -(define (word . o) - (apply string-append o)) - -(define-syntax-rule (substitution commands) - (let ((lst (pke 'split (split (pke 'string (with-output-to-string (lambda _ commands))))))) - (if (= (length lst) 1) (car lst) - lst))) - -(define-syntax if-clause - (lambda (x) - (syntax-case x () - ((_ expr then) - (with-syntax ((it (datum->syntax x 'it))) - #'(let ((it expr)) - (if (zero? it) then)))) - ((_ expr then else) - (with-syntax ((it (datum->syntax x 'it))) - #'(let ((it expr)) - (if (zero? it) then else))))))) - -(define (pipeline . commands) - (define (handle job) - (let* ((stati (cond ((job? job) (map status:exit-val (job-status job))) - ((boolean? job) (list (if job 0 1))) - ((number? job) (list job)) - (else (list 0)))) - (status (if (shell-opt? "pipefail") (or (find (negate zero?) stati) 0) - (car stati))) - (pipestatus (string-append - "(" - (string-join - (map (lambda (s i) - (format #f "[~a]=\"~a\"" s i)) - stati - (iota (length stati)))) - ")"))) - (assignment "PIPESTATUS" pipestatus) - (assignment "?" (number->string status)) - (when (and (not (zero? status)) - (shell-opt? "errexit")) - (exit status)) - status)) - (when (> %debug-level 1) - (format (current-error-port) "pijp: commands=~s\n" commands)) - ;; FIXME: after running a builtin, we still end up here with the builtin's result - ;; that should probably not happen, however, cater for it here for now - (match commands - (((and (? boolean?) boolean)) - (handle boolean)) - (((and (? number?) number)) - (handle number)) - (((? unspecified?)) - (handle #t)) - (_ (handle (apply pipeline+ #t commands))))) +(define (trace commands) + `(xtrace + ,(lambda _ + (when (shell-opt? "xtrace") + (for-each + (lambda (o) + (match o + (('command (and command (? string?)) ...) + (format (current-error-port) "+ ~a\n" (string-join command))) + (_ format (current-error-port) "+ ~s \n" o))) + (reverse commands)))))) (define %builtin-commands `( ("bg" . ,bg-command) - ("cat" . ,cat-command) ("command" . ,command-command) ("cd" . ,cd-command) - ("cp" . ,cp-command) ("echo" . ,echo-command) + ("eval" . ,eval-command) ("exit" . ,exit-command) ("fg" . ,fg-command) - ("find" . ,find-command) - ("grep" . ,grep-command) ("help" . ,help-command) ("jobs" . ,jobs-command) - ("ls" . ,ls-command) ("pwd" . ,pwd-command) - ("reboot" . ,reboot-command) - ("rm" . ,rm-command) ("set" . ,set-command) ("test" . ,test-command) ("type" . ,type-command) - ("wc" . ,wc-command) - ("which" . ,which-command) ("[" . ,bracket-command) )) diff --git a/gash/environment.scm b/gash/environment.scm index 5dbcee1..81de2ba 100644 --- a/gash/environment.scm +++ b/gash/environment.scm @@ -27,6 +27,7 @@ %global-variables assignment set-shell-opt! + shell-opt? variable )) @@ -60,3 +61,6 @@ (filter (negate (cut equal? <> name)) options))) (new-shell-opts (string-join new-options ":"))) (assignment "SHELLOPTS" new-shell-opts))) + +(define (shell-opt? name) + (member name (string-split (assoc-ref %global-variables "SHELLOPTS") #\:))) diff --git a/gash/gash.scm b/gash/gash.scm index 585d2dc..e7fb092 100644 --- a/gash/gash.scm +++ b/gash/gash.scm @@ -18,57 +18,47 @@ #:use-module (gash environment) #:use-module (gash job) #:use-module (gash pipe) - #:use-module (gash peg) #:use-module (gash io) + #:use-module (gash script) #:use-module (gash util) #:export (main %debug-level %prefer-builtins? - shell-opt?)) + parse + parse-string)) (define %debug-level 0) ; 1 informational, 2 verbose, 3 peg tracing (define %prefer-builtins? #f) ; use builtin, even if COMMAND is available in PATH? +(define %geesh-parser? #f) ; use Geesh parser [EXPERIMENTAL] -(define (remove-shell-comments s) - (string-join (map - (lambda (s) - (let* ((n (string-index s #\#))) - (if n (string-pad-right s (string-length s) #\space 0 n) - s))) - (string-split s #\newline)) "\n")) +(define (parse-string string) + (let ((parser (cond (%geesh-parser? (@ (gash geesh) parse-string)) + (else (@ (gash peg) parse-string))))) + (parser string))) -(define (remove-escaped-newlines s) - (reduce (lambda (next prev) - (let* ((escaped? (string-suffix? "\\" next)) - (next (if escaped? (string-drop-right next 1) next)) - (sep (if escaped? "" "\n"))) - (string-append prev sep next))) - "" (string-split s #\newline))) - -(define (file-to-string file-name) - (format (current-error-port) "gash: reading: ~s\n" file-name) - (with-input-from-file file-name read-string)) - -(define (string-to-ast string) - ((compose parse remove-escaped-newlines remove-shell-comments) string)) +(define (parse port) + (let ((parser (cond (%geesh-parser? (@ (gash geesh) parse)) + (else (@ (gash peg) parse))))) + (parser port))) (define (file-to-ast file-name) - ((compose string-to-ast file-to-string) file-name)) + (call-with-input-file file-name parse)) (define (display-help) (display "\ Usage: gash [OPTION]... [FILE]... Options: - -c, --command=STRING Evaluate STRING and exit - -e, --errexit Exit upon error - -d, --debug Enable PEG tracing - -h, --help Display this help - -p, --parse Parse the shell script and print the parse tree - --prefer-builtins Use builtins, even if command is available in PATH - -v, --version Display the version - -x, --xtrace Print simple command trace + -c, --command=STRING Evaluate STRING and exit + -e, --errexit Exit upon error + -d, --debug Enable PEG tracing + -g, --geesh Use Geesh parser [EXPERIMENTAL] + -h, --help Display this help + -p, --parse Parse the shell script and print the parse tree + --prefer-builtins Use builtins, even if command is available in PATH + -v, --version Display the version + -x, --xtrace Print simple command trace ")) (define (display-version) @@ -93,6 +83,7 @@ copyleft. (help (single-char #\h)) (parse (single-char #\p)) (prefer-builtins) + (geesh (single-char #\g)) (version (single-char #\v)) (xtrace (single-char #\x)))) (options (getopt-long args option-spec #:stop-at-first-non-option #t )) @@ -105,6 +96,7 @@ copyleft. (version? (option-ref options 'version #f)) (files (option-ref options '() '()))) (set! %prefer-builtins? (option-ref options 'prefer-builtins #f)) + (set! %geesh-parser? (option-ref options 'geesh #f)) (set-shell-opt! "errexit" (option-ref options 'errexit #f)) (set-shell-opt! "xtrace" (option-ref options 'xtrace #f)) (when (option-ref options 'debug #f) @@ -112,19 +104,24 @@ copyleft. (cond (help? (display-help)) (version? (display-version)) - (command? (let ((ast (string-to-ast command?))) - (exit (assoc-ref %global-variables "?")))) + (command? (let ((ast (parse-string command?))) + (if parse? (pretty-print ast) + (run ast)) + (exit (script-status)))) ((pair? files) - (let* ((asts (map file-to-ast files)) - (status (assoc-ref %global-variables "?"))) - (exit status))) + (let ((asts (map file-to-ast files))) + (if parse? (map pretty-print asts) + (for-each run asts)) + (exit (script-status)))) (#t (let* ((HOME (string-append (getenv "HOME") "/.gash_history")) (thunk (lambda () (let loop ((line (readline (prompt)))) (when (not (eof-object? line)) - (let* ((ast (string-to-ast line))) + (let* ((ast (parse-string line))) (when (and ast (not (string-null? line))) + (unless parse? + (run ast)) (add-history line)) (loop (let ((previous (if ast "" (string-append line "\n"))) (next (readline (if ast (prompt) "> ")))) @@ -137,77 +134,6 @@ copyleft. (newline)))))))) (thunk))) -(define (expand identifier o) ;;identifier-string -> symbol - (define (expand- o) - (let ((dollar-identifier (string-append "$" identifier))) - (match o - ((? symbol?) o) - ((? string?) (if (string=? o dollar-identifier) (string->symbol identifier) o)) - ((? list?) (map expand- o)) - (_ o)))) - (map expand- o)) - -(define (DEAD-background ast) - (match ast - (('pipeline fg rest ...) `(pipeline #f ,@rest)) - (_ ast))) - -(define (shell-opt? name) - (member name (string-split (assoc-ref %global-variables "SHELLOPTS") #\:))) - -(define (tostring . args) - (with-output-to-string (cut map display args))) - -;; transform ast -> list of expr -;; such that (map eval expr) -(define (DEAD-transform ast) - (format (current-error-port) "transform=~s\n" ast) - (match ast - (('script term "&") (list (background (transform term)))) - (('script term) `(,(transform term))) - (('script terms ...) (transform terms)) - (('substitution "$(" script ")") (local-eval (cons 'substitute (cddr (car (transform script)))) (the-environment))) - (('substitution "`" script "`") (local-eval (cons 'substitute (cddr (car (transform script)))) (the-environment))) - ((('term command)) `(,(transform command))) - ((('term command) ...) (map transform command)) - ((('term command) (('term commands) ...)) (map transform (cons command commands))) - (('compound-list terms ...) (transform terms)) - (('if-clause "if" (expression "then" consequent "fi")) - `(if (equal? 0 (status:exit-val ,@(transform expression))) - (begin ,@(transform consequent)))) - (('if-clause "if" (expression "then" consequent ('else-part "else" alternative) "fi")) - `(if (equal? 0 (status:exit-val ,@(transform expression))) - (begin ,@(transform consequent)) - (begin ,@(transform alternative)))) - (('for-clause ("for" identifier sep do-group)) #t) - (('for-clause "for" ((identifier "in" lst sep) do-group)) - `(for-each (lambda (,(string->symbol identifier)) - (begin ,@(expand identifier (transform do-group)))) - (glob ,(transform lst)))) - (('do-group "do" (command "done")) (transform command)) - (('pipeline command) (pk 1) (let* ((command (transform command))) (or (builtin command) `(pipeline #t ,@command)))) - (('pipeline command piped-commands) (pk 2) `(pipeline #t ,@(transform command) ,@(transform piped-commands))) - (('simple-command ('word (assignment name value))) `((lambda _ (let ((name ,(tostring (transform name))) - (value ,(tostring (transform value)))) - (stderr "assignment: " name "=" value) - (set! global-variables (assoc-set! global-variables name (glob value))))))) - (('simple-command ('word s)) `((glob ,(transform s)))) - (('simple-command ('word s1) ('io-redirect "<<" ('here-document s2))) `((append (glob "echo") (cons "-n" (glob ,s2))) (glob ,(transform s1)))) - (('simple-command ('word s1) ('word s2)) `((append (glob ,(transform s1)) (glob ,(transform s2))))) - (('simple-command ('word s1) (('word s2) ...)) `((append (glob ,(transform s1)) (append-map glob (list ,@(map transform s2)))))) - (('variable s) s) - (('literal s) (transform s)) - (('singlequotes s) (string-concatenate `("'" ,s "'"))) - (('doublequotes s) (string-concatenate `("\"" ,s "\""))) - (('backticks s) (string-concatenate `("`" ,s "`"))) - (('delim ('singlequotes s ...)) (string-concatenate (map transform s))) - (('delim ('doublequotes s ...)) (string-concatenate (map transform s))) - (('delim ('backticks s ...)) (string-concatenate (map transform s))) - ((('pipe _) command) (transform command)) - (((('pipe _) command) ...) (map (compose car transform) command)) - ((_ o) (transform o)) ;; peel the onion: (symbol (...)) -> (...) - (_ ast))) ;; done - (define prompt (let* ((l (string #\001)) (r (string #\002)) diff --git a/gash/geesh.scm b/gash/geesh.scm new file mode 100644 index 0000000..db7546a --- /dev/null +++ b/gash/geesh.scm @@ -0,0 +1,127 @@ +;;; Gash -- Guile As SHell +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; +;;; This file is part of Gash. +;;; +;;; Gash is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Gash is distributed in the hope that it will be useful, but WITHOUT ANY +;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +;;; details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Gash. If not, see . + +(define-module (gash geesh) + #:use-module (srfi srfi-1) + + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + + #:use-module (gash builtins) + #:use-module (gash gash) + #:use-module (gash io) + #:use-module (geesh parser) + #:export ( + parse + parse-string + )) + +(define (parse port) + (let ((parse-tree (read-sh-all port))) + (when (> %debug-level 1) + (format (current-error-port) "parse-tree:\n") + (pretty-print parse-tree (current-error-port))) + (let ((ast (parse-tree->script parse-tree))) + (format (current-error-port) "transformed:\n") + (pretty-print ast (current-error-port)) + (let* ((script (match ast + (((or 'command 'pipeline) _ ...) `(script ,ast)) + ((_ ...) `(script ,@ast)) + (_ `(script ,ast)))) + (tracing-script (annotate-tracing script))) + (when (> %debug-level 0) + (format (current-error-port) "script:\n") + (pretty-print tracing-script (current-error-port))) + tracing-script)))) + +(define (parse-string string) + (call-with-input-string string parse)) + +(define (parse-tree->script tree) + (define (transform o) + (when (> %debug-level 2) + (format (current-error-port) "transform:\n") + (pretty-print o (current-error-port))) + (match o + ((' body ...) `(begin ,@(map transform body))) + ((' ((' (left ...))) right) + `(pipeline ,@(map transform left) ,(transform right))) + ((' (' (left ...) right)) + `(pipeline ,@(map transform left) ,(transform right))) + ((' (left right)) + `(pipeline ,(transform left) ,(transform right))) + ((' command) `(command ,(transform command))) + ((' command ...) `(command ,@(map transform command))) + (((and ref (' _)) words ...) + `(word ,(transform ref) ,@(map transform words))) + ((' var) `(variable ,var)) + ((' (var (and value ((? symbol?) _ ...)))) + `(assignment ,(transform var) ,(transform value))) + ((' (var (value ...))) + `(assignment ,(transform var) (word ,@(map transform value)))) + ((' (var value)) `(assignment ,(transform var) ,(transform value))) + (((and kwote (' _)) word) + `(word ,(transform kwote) ,(transform word))) + ((') + `(doublequotes "")) + ((' words ...) + `(doublequotes (word ,@(map transform words)))) + (((and quote (' _)) tail ...) + `(word ,(transform quote) ,@(map transform tail))) + ((' cmd) `(substitution ,(transform cmd))) + ((' (expression then)) `(if-clause ,(transform expression) ,(transform then))) + ((' (('<< 0 string)) pipeline) + (let ((pipeline (pke 'pipeline (transform pipeline)))) + `(pipeline (display ,(transform string)) + ,@(match pipeline + (('command command ...) `(,pipeline)) + (('pipeline commands ...) commands))))) + + ((' (name (sequence)) body) + `(for ,(transform name) + (lambda _ (split ,(transform sequence))) + (lambda _ ,(transform body)))) + + ((' (name sequence) body) + `(for ,(transform name) + (lambda _ (split ,(transform sequence))) + (lambda _ ,(transform body)))) + + ((? string?) o) + (((? string?) _ ...) `(word ,@(map re-word o))) + ((_ ...) (map transform o)) + (_ o))) + (transform tree)) + +(define (re-word word) + (match word + ((? string?) word) + (((and h (? string?)) t ...) + `(word ,h ,@(map (compose re-word parse-tree->script) t))) + (_ (parse-tree->script word)))) + +(define (annotate-tracing script) + (match script + (('pipeline command) + `(pipeline ,(trace (list command)) ,command)) + (('pipeline commands ...) + `(pipeline ,(trace commands) ,@commands)) + (('command command ...) + `(pipeline ,(trace (list script)) ,script)) + ((_ ...) (map annotate-tracing script)) + (_ script))) diff --git a/gash/guix-build-utils.scm b/gash/guix-build-utils.scm index a9c2639..5e60386 100644 --- a/gash/guix-build-utils.scm +++ b/gash/guix-build-utils.scm @@ -34,6 +34,7 @@ dump-port file-name-predicate find-files + grep* grep grep-match-file-name @@ -163,17 +164,24 @@ transferred and the continuation of the transfer as a thunk." (column grep-match-column) (end-column grep-match-end-column)) -(define (grep regexp file) - (call-with-input-file file - (lambda (in) - (let loop ((line (read-line in)) (ln 1) (matches '())) - (if (eof-object? line) (reverse matches) - (let* ((m (list-matches regexp line)) - (m (and (pair? m) (car m)))) - (loop (read-line in) (1+ ln) - (if m (cons (make-grep-match file - (match:string m) - ln - (match:start m) - (match:end m)) matches) - matches)))))))) +(define* (grep* pattern #:key (port (current-input-port)) (file-name "")) + ;; FIXME: collect later? for scripting usage implicit collect is + ;; nice; for pipeline usage not so much + (let loop ((line (read-line port)) (ln 1) (matches '())) + (if (eof-object? line) (reverse matches) + (let* ((m (list-matches pattern line)) + (m (and (pair? m) (car m)))) + (loop (read-line port) (1+ ln) + (if m (cons (make-grep-match file-name + (match:string m) + ln + (match:start m) + (match:end m)) matches) + matches)))))) + +(define (grep pattern file) + (cond ((and (string? file) + (not (equal? file "-"))) (call-with-input-file file + (lambda (in) + (grep* pattern #:port in #:file-name file)))) + (else (grep* pattern)))) diff --git a/gash/job.scm b/gash/job.scm index 5220244..fe0b906 100644 --- a/gash/job.scm +++ b/gash/job.scm @@ -7,18 +7,21 @@ #:use-module (gash io) #:use-module (gash util) - #:export (bg + #:export ( + bg fg + display-job + job-table job? job-add-process job-control-init job-debug-id job-setup-process job-status - jobs-command new-job report-jobs - wait)) + wait + )) (define-record-type (make-process pid command status) @@ -67,9 +70,6 @@ (stdout "[" (job-id job) "] " (map status->state (job-status job)) "\t\t" (job-command job))) -(define (jobs-command) - (for-each (lambda (job) (display-job job)) (reverse job-table))) - (define (job-status job) (map process-status (job-processes job))) diff --git a/gash/peg.scm b/gash/peg.scm index af9228a..b012077 100644 --- a/gash/peg.scm +++ b/gash/peg.scm @@ -4,6 +4,7 @@ #:use-module (ice-9 pretty-print) #:use-module (ice-9 peg) #:use-module (ice-9 peg codegen) + #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -13,10 +14,11 @@ #:use-module (gash environment) #:use-module (gash gash) #:use-module (gash io) - #:use-module (gash job) + #:use-module (gash script) #:export ( parse + parse-string peg-trace? )) @@ -64,6 +66,74 @@ (or (loop (car x)) (loop (cdr x))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; WIP +(define (expand identifier o) ;;identifier-string -> symbol + (define (expand- o) + (let ((dollar-identifier (string-append "$" identifier))) + (match o + ((? symbol?) o) + ((? string?) (if (string=? o dollar-identifier) (string->symbol identifier) o)) + ((? list?) (map expand- o)) + (_ o)))) + (map expand- o)) + +(define (tostring . args) + (with-output-to-string (cut map display args))) + +;; transform ast -> list of expr +;; such that (map eval expr) +(define (DEAD-transform ast) + (format (current-error-port) "transform=~s\n" ast) + (match ast + (('script term "&") (list (background (transform term)))) + (('script term) `(,(transform term))) + (('script terms ...) (transform terms)) + (('substitution "$(" script ")") (local-eval (cons 'substitute (cddr (car (transform script)))) (the-environment))) + (('substitution "`" script "`") (local-eval (cons 'substitute (cddr (car (transform script)))) (the-environment))) + ((('term command)) `(,(transform command))) + ((('term command) ...) (map transform command)) + ((('term command) (('term commands) ...)) (map transform (cons command commands))) + (('compound-list terms ...) (transform terms)) + (('if-clause "if" (expression "then" consequent "fi")) + `(if (equal? 0 (status:exit-val ,@(transform expression))) + (begin ,@(transform consequent)))) + (('if-clause "if" (expression "then" consequent ('else-part "else" alternative) "fi")) + `(if (equal? 0 (status:exit-val ,@(transform expression))) + (begin ,@(transform consequent)) + (begin ,@(transform alternative)))) + (('for-clause ("for" identifier sep do-group)) #t) + (('for-clause "for" ((identifier "in" lst sep) do-group)) + `(for-each (lambda (,(string->symbol identifier)) + (begin ,@(expand identifier (transform do-group)))) + (glob ,(transform lst)))) + (('do-group "do" (command "done")) (transform command)) + (('pipeline command) (pk 1) (let* ((command (transform command))) (or (builtin command) `(pipeline #t ,@command)))) + (('pipeline command piped-commands) (pk 2) `(pipeline #t ,@(transform command) ,@(transform piped-commands))) + (('simple-command ('word (assignment name value))) `((lambda _ (let ((name ,(tostring (transform name))) + (value ,(tostring (transform value)))) + (stderr "assignment: " name "=" value) + (set! global-variables (assoc-set! global-variables name (glob value))))))) + (('simple-command ('word s)) `((glob ,(transform s)))) + (('simple-command ('word s1) ('io-redirect "<<" ('here-document s2))) `((append (glob "echo") (cons "-n" (glob ,s2))) (glob ,(transform s1)))) + (('simple-command ('word s1) ('word s2)) `((append (glob ,(transform s1)) (glob ,(transform s2))))) + (('simple-command ('word s1) (('word s2) ...)) `((append (glob ,(transform s1)) (append-map glob (list ,@(map transform s2)))))) + (('variable s) s) + (('literal s) (transform s)) + (('singlequotes s) (string-concatenate `("'" ,s "'"))) + (('doublequotes s) (string-concatenate `("\"" ,s "\""))) + (('backticks s) (string-concatenate `("`" ,s "`"))) + (('delim ('singlequotes s ...)) (string-concatenate (map transform s))) + (('delim ('doublequotes s ...)) (string-concatenate (map transform s))) + (('delim ('backticks s ...)) (string-concatenate (map transform s))) + ((('pipe _) command) (transform command)) + (((('pipe _) command) ...) (map (compose car transform) command)) + ((_ o) (transform o)) ;; peel the onion: (symbol (...)) -> (...) + (_ ast))) ;; done + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (parse- input) (define label "") (define (label-name str len pos) @@ -195,36 +265,10 @@ (define (flatten o) (keyword-flatten '(and assignent command doublequotes for-clause literal name or pipeline singlequotes substitution word) o)) -(define (parse input) - (let* ((pt (parse- input)) - (foo (when (> %debug-level 1) (display "tree:\n") (pretty-print pt))) - (flat (flatten pt)) - (foo (when (> %debug-level 0) (display "flat:\n") (pretty-print flat))) - (ast (transform flat)) - (foo (when (> %debug-level 0) (display "ast:\n") (pretty-print ast)))) - (cond ((error? ast) - (stderr "error:") (pretty-print ast (current-error-port)) #f) - ((eq? ast 'script) - #t) - (else - (map (cut local-eval <> (the-environment)) ast) - ast)))) (define (unspecified? o) (eq? o *unspecified*)) -(define (trace commands) - `(xtrace - ,(lambda _ - (when (shell-opt? "xtrace") - (for-each - (lambda (o) - (match o - (('command (and command (? string?)) ...) - (format (current-error-port) "+ ~a\n" (string-join command))) - (_ format (current-error-port) "+ ~s \n" o))) - (reverse commands)))))) - (define (transform ast) (when (> %debug-level 1) (pretty-print ast (current-error-port))) @@ -240,8 +284,10 @@ ((('singlequotes _ ...) _ ...) (map transform (flatten ast))) ((('word _ ...) _ ...) (map transform (flatten ast))) + (('script ('pipeline ('command command ... (word (literal "&"))))) + (background `(pipeline ',(map transform command)))) - (('script o ...) `(script ,@(map transform o))) + (('script terms ...) `(script ,@(map transform terms))) (('pipeline o ...) (let ((commands (map transform o))) @@ -254,6 +300,7 @@ ;;(('assignment a b) `(assignment ,(transform a) ',(transform b))) ;; FIXME: to quote or not? + (('assignment a) `(substitution (variable ,(transform a)))) (('assignment a b) `(assignment ,(transform a) ,(transform b))) ;; (('assignment a (and b ('literal _ ...))) `(assignment ,(transform a) ,(transform b))) @@ -261,8 +308,8 @@ ;; `(assignment ,(transform a) ,(map transform b))) - (('for-clause name expr (and body ('pipeline _ ...))) - `(for ,(transform name) (lambda _ ,(transform expr)) (lambda _ ,(transform body)))) + (('for-clause name sequence (and body ('pipeline _ ...))) + `(for ,(transform name) (lambda _ ,(transform sequence)) (lambda _ ,(transform body)))) (('for-clause name expr body) `(for ,(transform name) (lambda _ ,(transform expr)) (lambda _ ,@(map transform body)))) (('sequence o) @@ -290,3 +337,37 @@ (('word o) (transform o)) (('word o ...) `(string-append ,@(map transform o))) (_ ast))) + + +(define (remove-shell-comments s) + (string-join (map + (lambda (s) + (let* ((n (string-index s #\#))) + (if n (string-pad-right s (string-length s) #\space 0 n) + s))) + (string-split s #\newline)) "\n")) + +(define (remove-escaped-newlines s) + (reduce (lambda (next prev) + (let* ((escaped? (string-suffix? "\\" next)) + (next (if escaped? (string-drop-right next 1) next)) + (sep (if escaped? "" "\n"))) + (string-append prev sep next))) + "" (string-split s #\newline))) + +(define (parse-string string) + (let* ((pt ((compose parse- remove-escaped-newlines remove-shell-comments) string)) + (foo (when (> %debug-level 1) (display "tree:\n") (pretty-print pt))) + (flat (flatten pt)) + (foo (when (> %debug-level 0) (display "flat:\n") (pretty-print flat))) + (ast (transform flat)) + (foo (when (> %debug-level 0) (display "ast:\n") (pretty-print ast)))) + (cond ((error? ast) + (stderr "error:") (pretty-print ast (current-error-port)) #f) + ((eq? ast 'script) + #t) + (else ast)))) + +(define (parse port) + (parse-string (read-string port))) + diff --git a/gash/script.scm b/gash/script.scm new file mode 100644 index 0000000..f223846 --- /dev/null +++ b/gash/script.scm @@ -0,0 +1,251 @@ +;;; Gash -- Guile As SHell +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; +;;; This file is part of Gash. +;;; +;;; Gash is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Gash is distributed in the hope that it will be useful, but WITHOUT ANY +;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +;;; details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Gash. If not, see . + +(define-module (gash script) + #:use-module (ice-9 ftw) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 local-eval) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 receive) + #:use-module (ice-9 regex) + + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + + #:use-module (gash bournish-commands) + #:use-module (gash builtins) + #:use-module (gash config) + #:use-module (gash environment) + #:use-module (gash gash) + #:use-module (gash guix-build-utils) + #:use-module (gash io) + #:use-module (gash job) + #:use-module (gash pipe) + #:use-module (gash util) + + #:export ( + background + builtin + command + doublequotes + for + glob + if-clause + ignore-error + pipeline + run + script + script-status + sequence + singlequotes + splice + split + substitution + word + xtrace + )) + +(define (background term) + (format (current-error-port) "background: ~s\n" term) + (match (pke 'background-term term) + (('pipeline command) (pke 'background: `(pipeline+ #f ,command))) + (_ term))) + +(define (command . args) + (define (exec command) + (cond ((procedure? command) command) + ((every string? command) + (let* ((program (car command)) + (escape-builtin? (and (string? program) (string-prefix? "\\" program))) + (program (if escape-builtin? (string-drop program 1) program)) + (command (cons program (cdr command)))) + (or (builtin command #:prefer-builtin? (and %prefer-builtins? + (not escape-builtin?))) + (cut apply (compose status:exit-val system*) command)))) + (else (lambda () #t)))) + (exec (append-map glob args))) + +(define (glob pattern) + (define (glob? pattern) + (and (string? pattern) (string-match "\\?|\\*" pattern))) + (define (glob2regex pattern) + (let* ((pattern (regexp-substitute/global #f "\\." pattern 'pre "\\." 'post)) + (pattern (regexp-substitute/global #f "\\?" pattern 'pre "." 'post)) + (pattern (regexp-substitute/global #f "\\*" pattern 'pre ".*" 'post))) + (make-regexp (string-append "^" pattern "$")))) + (define (glob-match regex path) ;; pattern path -> bool + (regexp-match? (regexp-exec regex path))) + (define (glob- pattern file-names) + (map (lambda (file-name) + (if (string-prefix? "./" file-name) (string-drop file-name 2) file-name)) + (append-map (lambda (file-name) + (map (cut string-append (if (string=? "/" file-name) "" file-name) "/" <>) + (filter (conjoin (negate (cut string-prefix? "." <>)) + (cute glob-match (glob2regex pattern) <>)) + (or (scandir file-name) '())))) + file-names))) + (cond + ((not pattern) '("")) + ((glob? pattern) (let ((absolute? (string-prefix? "/" pattern))) + (let loop ((patterns (filter (negate string-null?) (string-split pattern #\/))) + (file-names (if absolute? '("/") '(".")))) + (if (null? patterns) + file-names + (begin + (loop (cdr patterns) (glob- (car patterns) file-names))))))) + (#t (list pattern)))) + +(define (singlequotes . o) + (string-join o "")) + +(define (doublequotes . o) + (string-join (append-map glob o) "")) + +(define (sequence . args) + (format (current-error-port) "sequence args=~s\n" args) + (let ((glob (append-map glob (apply append args)))) + (format (current-error-port) " => sequence glob=~s\n" glob) + glob)) + +(define (run ast) + (map (cut local-eval <> (the-environment)) ast)) + +(define (script-status) + ((compose string->number variable) "?")) + +(define (script . o) + o) + +(define (for name sequence body) + (for-each (lambda (value) + (assignment name value) + (body)) + (sequence))) + +(define (split o) + ((compose string-tokenize string-trim-right) o)) + +(define (xtrace o) + (o)) + +(define (word . o) + (define (flatten o) + (match o + ((h t ...) (append (flatten h) (append-map flatten t))) + (_ (list o)))) + (string-join (flatten o) "")) + +(define-syntax-rule (substitution commands) + (with-output-to-string (lambda _ commands))) + +(define-syntax-rule (ignore-error o) + (let ((errexit (shell-opt? "errexit"))) + (when errexit + (set-shell-opt! "errexit" #f)) + (let ((r o)) + (assignment "?" "0") + (when errexit + (set-shell-opt! " errexit" #t)) + r))) + +(define-syntax if-clause + (lambda (x) + (syntax-case x () + ((_ expr then) + (with-syntax ((it (datum->syntax x 'it))) + #'(let ((it (ignore-error expr))) + (if (zero? it) then)))) + ((_ expr then else) + (with-syntax ((it (datum->syntax x 'it))) + #'(let ((it (ignore-error expr))) + (if (zero? it) then else))))))) + +(define (pipeline . commands) + (define (handle job) + (when (> %debug-level 1) + (format (current-error-port) "job=~s\n" job)) + (let* ((stati (cond ((job? job) (map status:exit-val (job-status job))) + ((boolean? job) (list (if job 0 1))) + ((number? job) (list job)) + (else (list 0)))) + (foo (when (> %debug-level 1) + (format (current-error-port) "stati=~s\n" stati))) + (status (if (shell-opt? "pipefail") (or (find (negate zero?) stati) 0) + (car stati))) + (pipestatus (string-append + "(" + (string-join + (map (lambda (s i) + (format #f "[~a]=\"~a\"" s i)) + stati + (iota (length stati)))) + ")"))) + (assignment "PIPESTATUS" pipestatus) + (assignment "?" (number->string status)) + (when (and (not (zero? status)) + (shell-opt? "errexit")) + (exit status)) + status)) + (when (> %debug-level 1) + (format (current-error-port) "pijp: commands=~s\n" commands)) + ;; FIXME: after running a builtin, we still end up here with the builtin's result + ;; that should probably not happen, however, cater for it here for now + (match commands + (((and (? boolean?) boolean)) + (handle boolean)) + (((and (? number?) number)) + (handle number)) + (((? unspecified?)) + (handle #t)) + (_ (handle (apply pipeline+ #t commands))))) + +(define* (builtin ast #:key prefer-builtin?) + ;; FIXME: distinguish between POSIX compliant builtins and + ;; `best-effort'/`fallback'? + "Possibly modify command to use a builtin." + (when (> %debug-level 0) + (format (current-error-port) "builtin ast=~s\n" ast)) + (receive (command args) + (match ast + (((and (? string?) command) args ...) (values command args)) + (_ (values #f #f))) + (let ((program (and command + (cond ((string-prefix? "/" command) + (when (not (file-exists? command)) + (format (current-error-port) "gash: ~a: no such file or directory\n" command)) + command) + (else (PATH-search-path command)))))) + ;; FIXME: find some generic strerror/errno way: what about permissions and stuff? + ;; after calling system* we're too late for that? + (when (> %debug-level 0) + (format (current-error-port) "command ~a => ~s ~s\n" (or program 'builtin) command args)) + (cond ((and program (not prefer-builtin?)) + (when (not program) + (format (current-error-port) "gash: ~a: command not found\n" command)) + (when (not (access? program X_OK)) + (format (current-error-port) "gash: ~a: permission denied\n" command)) + #f) + ((and command (or (assoc-ref %builtin-commands command) + (assoc-ref %bournish-commands command))) + => + (lambda (command) + (if args + (apply command (map (cut local-eval <> (the-environment)) args)) + (command)))) + (else #f))))) diff --git a/gash/util.scm b/gash/util.scm index ce1c8b5..6bd68ad 100644 --- a/gash/util.scm +++ b/gash/util.scm @@ -2,7 +2,11 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (disjoin conjoin)) + #:export ( + conjoin + disjoin + wrap-command + )) (define (disjoin . predicates) (lambda (. arguments) @@ -11,3 +15,11 @@ (define (conjoin . predicates) (lambda (. arguments) (every (cut apply <> arguments) predicates))) + +(define (wrap-command command name) + (lambda args + (catch #t + (cut apply command args) + (lambda (key . args) + (format (current-error-port) "~a: ~a ~a\n" name key args) + 1)))) diff --git a/test.sh b/test.sh index 92f269c..77c258d 100755 --- a/test.sh +++ b/test.sh @@ -1,11 +1,12 @@ if [ -n "$BUILD_DEBUG" ]; then set -x fi -SHELL=${SHELL-bin/gash} +#SHELL=${SHELL-bin/gash} +SHELL=bin/gash for f in test/*.sh; do echo -n "$f: " b=test/$(basename $f .sh) - $SHELL -e $f + $SHELL --geesh -e $f r=$? if [ -f $b.exit ]; then e=$(cat $b.exit) diff --git a/test/05-assignment-doublequoted-doublequotes.sh b/test/05-assignment-doublequoted-doublequotes.sh new file mode 100644 index 0000000..ef6751f --- /dev/null +++ b/test/05-assignment-doublequoted-doublequotes.sh @@ -0,0 +1,5 @@ +#set -x +aliaspath=alias +localedir=x +defines="-DALIASPATH=\"${aliaspath}\" -DLOCALEDIR=\"${localedir}\"" +echo cc $defines diff --git a/test/06-assignment-singlequote.sh b/test/06-assignment-singlequote.sh new file mode 100644 index 0000000..77f0bb1 --- /dev/null +++ b/test/06-assignment-singlequote.sh @@ -0,0 +1 @@ +srcdir='.' diff --git a/test/07-assignment-double-quote.sh b/test/07-assignment-double-quote.sh new file mode 100644 index 0000000..6b03911 --- /dev/null +++ b/test/07-assignment-double-quote.sh @@ -0,0 +1 @@ +srcdir="." diff --git a/test/08-assignment-variable-word.sh b/test/08-assignment-variable-word.sh new file mode 100644 index 0000000..4525fdf --- /dev/null +++ b/test/08-assignment-variable-word.sh @@ -0,0 +1 @@ +libdir=${exec_prefix}/lib diff --git a/test/09-compound-word.sh b/test/09-compound-word.sh new file mode 100644 index 0000000..e806293 --- /dev/null +++ b/test/09-compound-word.sh @@ -0,0 +1,2 @@ +srcdir=. +echo cc -c ${srcdir}/$file diff --git a/test/0a-assign-substitute.sh b/test/0a-assign-substitute.sh new file mode 100644 index 0000000..91b1091 --- /dev/null +++ b/test/0a-assign-substitute.sh @@ -0,0 +1,2 @@ +obj=ar.o +objs="$objs `basename $obj`" diff --git a/test/0b-command-compound-word.sh b/test/0b-command-compound-word.sh new file mode 100644 index 0000000..224bcd8 --- /dev/null +++ b/test/0b-command-compound-word.sh @@ -0,0 +1,3 @@ +CC=echo +file=ar.o +$CC -I${srcdir} $file diff --git a/test/10-if.sh b/test/10-if.sh new file mode 100644 index 0000000..f61cd14 --- /dev/null +++ b/test/10-if.sh @@ -0,0 +1,4 @@ +if true; then + exit 0 +fi +exit 1 diff --git a/test/11-if-false.sh b/test/11-if-false.sh new file mode 100644 index 0000000..04581c1 --- /dev/null +++ b/test/11-if-false.sh @@ -0,0 +1,4 @@ +if false; then + exit 1 +fi +exit 0 diff --git a/test/08-assignment-susbtitution.sh b/test/30-assignment-substitution.sh similarity index 100% rename from test/08-assignment-susbtitution.sh rename to test/30-assignment-substitution.sh diff --git a/test/30-eval.sh b/test/30-eval.sh new file mode 100644 index 0000000..c5f9af1 --- /dev/null +++ b/test/30-eval.sh @@ -0,0 +1 @@ +eval echo 0 diff --git a/test/31-eval-echo-variable.sh b/test/31-eval-echo-variable.sh new file mode 100644 index 0000000..5882a93 --- /dev/null +++ b/test/31-eval-echo-variable.sh @@ -0,0 +1,2 @@ +bar=SHELL +eval echo '$'$bar diff --git a/test/32-for-substitute.sh b/test/32-for-substitute.sh new file mode 100644 index 0000000..a2a630e --- /dev/null +++ b/test/32-for-substitute.sh @@ -0,0 +1,3 @@ +for file in `echo ar.o arscan.o`; do + echo compiling ${file}... +done diff --git a/test/35-assignment-eval-echo.sh b/test/35-assignment-eval-echo.sh new file mode 100644 index 0000000..905da22 --- /dev/null +++ b/test/35-assignment-eval-echo.sh @@ -0,0 +1 @@ +exec_prefix=`eval echo ${prefix}` diff --git a/test/assign2.sh b/test/assign2.sh index 190d2de..5a9c238 100644 --- a/test/assign2.sh +++ b/test/assign2.sh @@ -1 +1,3 @@ defines="-DALIASPATH=\"${aliaspath}\" -" +echo defines:$defines + diff --git a/test/for-split-sequence.sh b/test/for-split-sequence.sh new file mode 100644 index 0000000..4716fe7 --- /dev/null +++ b/test/for-split-sequence.sh @@ -0,0 +1,5 @@ +one=1 +two_n_halve= +for i in 0 $one 2 $two_n_halve 3 ""; do + echo $i; +done diff --git a/test/for.sh b/test/for.sh new file mode 100644 index 0000000..a647d4e --- /dev/null +++ b/test/for.sh @@ -0,0 +1,3 @@ +for i in 0 1 2; do + echo $i; +done diff --git a/test/if.sh b/test/if.sh deleted file mode 100644 index b0e4dd0..0000000 --- a/test/if.sh +++ /dev/null @@ -1,3 +0,0 @@ -if [ x"$y" != x ]; then - echo boo -fi diff --git a/test/iohere.sh b/test/iohere.sh index 12cda66..15ff922 100644 --- a/test/iohere.sh +++ b/test/iohere.sh @@ -1,4 +1,3 @@ cat <