;;; Gash -- Guile As SHell
;;; Copyright © 2018, 2019, 2021 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Gash.
;;;
;;; Gash is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Gash is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (gnu packages bash)
             (gnu packages python)
             (gnu packages time)
             (guix gexp)
             (guix git-download)
             (guix modules)
             (guix monads)
             (guix packages)
             (guix store))

(let* ((commit "0869f9cd4d63ff6317ed7c3718e15c14aeb44d79")
       (version (git-version "0.6.pre21" "0" commit))
       (source
        (origin
          (method git-fetch)
          (uri (git-reference
                (url "https://github.com/oilshell/oil.git")
                (commit commit)))
          (file-name (string-append "oil-" version "-checkout"))
          (sha256
           (base32
            "0pyz4mgqmn7dl514klmxsw8z8kdnsh91a7ixnczilswbqka2j75g")))))
  (run-with-store (open-connection)
    (with-imported-modules (source-module-closure
                            '((guix build utils)))
      (gexp->derivation
       (string-append "oil-tests-" version)
       #~(begin
           (use-modules (guix build utils)
                        (ice-9 match)
                        (ice-9 rdelim)
                        (ice-9 regex)
                        (srfi srfi-1))
           (copy-recursively #$source #$output)
           (setenv "PATH" (list->search-path-as-string
                           (map (lambda (p)
                                  (string-append p "/bin"))
                                (list #$bash-minimal
                                      #$python-2
                                      #$time))
                           ":"))
           (chdir #$output)
           (for-each patch-shebang
                     '("spec/bin/argv.py"
                       "spec/bin/printenv.py"
                       "test/common.sh"
                       "test/sh_spec.py"
                       "test/spec-runner.sh"
                       "test/spec.sh"))
           (substitute* "test/common.sh"
             (("/usr/bin/env time") (which "time")))

           ;; Disable all shells.  This is mostly for reproducibility,
           ;; since it is annoying when the tests fail because a
           ;; different set of reference shells are available.
           (substitute* "test/spec.sh"
             (("readonly BASH=\\$[(]shell-path bash[)]") "readonly BASH=")
             (("BUSYBOX_ASH=_tmp/shells/ash") "BUSYBOX_ASH=")
             (("readonly DASH=\\$[(]shell-path dash[)]") "readonly DASH=")
             (("readonly MKSH=\\$[(]shell-path mksh[)]") "readonly MKSH=")
             (("readonly ZSH=\\$[(]shell-path zsh[)]") "readonly ZSH="))

           ;; This is not necessary, but it makes the output nicer.
           (substitute* "test/spec.sh"
             (("which \\$name") "which $name 2>/dev/null"))

           ;; We want to omit tests that use features we do not
           ;; support yet.  This lets us add tests quickly, and expand
           ;; to the more integrated tests as we are able.
           (let ((filter-tests
                  (lambda (tests file)
                    (format #t "Removing tests from ~a:~%" file)
                    (with-atomic-file-replacement file
                      (lambda (in out)
                        ;; The Oil tests are encoded as UTF-8, so we
                        ;; set the encoding on the two ports to ensure
                        ;; that Guile preserves non-ASCII characters.
                        (set-port-encoding! in "UTF-8")
                        (set-port-encoding! out "UTF-8")
                        (let loop ((line (read-line in 'concat))
                                   (transformers #t))
                          (cond
                           ((eof-object? line) #t)
                           ((string-prefix? "####" line)
                            (let* ((name-part (substring line 4))
                                   (name (string-trim-both name-part)))
                              (match (assoc name tests)
                                ((_ . ())
                                 (format #t "  - ~a~%" name)
                                 (loop (read-line in 'concat) #f))
                                ((_ . (transformers ..1))
                                 (format #t "  * ~a~%" name)
                                 (display line out)
                                 (loop (read-line in 'concat) transformers))
                                (#f
                                 (display line out)
                                 (loop (read-line in 'concat) #t)))))
                           (else
                            (match transformers
                              (#f #t)
                              (#t (display line out))
                              (((targets replacements) ..1)
                               (display
                                (fold (lambda (target replacement line)
                                        (regexp-substitute/global
                                         #f target line
                                         'pre replacement 'post))
                                      line
                                      targets replacements)
                                out)))
                            (loop (read-line in 'concat) transformers))))))))
                 (tests-to-filter
                  `(("spec/arith.test.sh"
                     (;; These are Bash specific.
                      ("Side Effect in Array Indexing")
                      ("Array indexing in arith")
                      ;; These go beyond POSIX.
                      ("Invalid string to int with strict-arith")
                      ("Preincrement")
                      ("Postincrement")
                      ("Increment undefined variables")
                      ("Increment and decrement array")
                      ("Increment undefined variables with nounset")
                      ("Comma operator (borrowed from C)")
                      ("Constants in base 36")
                      ("Constants in bases 2 to 64")
                      ("Dynamic base constants")
                      ;; Following POSIX, we keep the quotes in the
                      ;; expession.
                      ("Constant with quotes like '1'"
                       ("N-I bash/zsh" "N-I bash/zsh/gash"))
                      ;; Follow bash/mksh and return status 1.
                      ("No floating point"
                       ("OK bash/mksh" "OK bash/mksh/gash"))
                      ;; We do not support nounset yet.
                      ("nounset with arithmetic")
                      ;; We return 1 here.
                      ("Invalid LValue"
                       ("## status: 2" ,(string-append
                                         "## status: 2\n"
                                         "## OK gash status: 1\n")))
                      ;; Follow Dash on these two.
                      ("Invalid LValue that looks like array"
                       ("N-I dash" "N-I dash/gash"))
                      ("Invalid LValue: two sets of brackets"
                       ("N-I dash" "N-I dash/gash"))
                      ;; We do not support exponentiation.
                      ("Exponentiation with **")
                      ("Exponentiation operator has buggy precedence")
                      ;; This test seems to be broken.
                      ("Logical Ops Short Circuit"
                       ("\\(\\(" "y=$(("))
                      ;; Not sure about this one.  We only do one
                      ;; layer of variable lookup.
                      ("Bizarre recursive name evaluation - result of runtime parse/eval"
                       ("## stdout: 6 6 6 6"
                        ,(string-append
                          "## stdout: 6 6 6 6\n"
                          "## OK gash stdout: 6 1 1 1\n")))))
                    ("spec/case_.test.sh"
                     (;; These two are Bash specific.
                      ("Case statement with ;;&")
                      ("Case statement with ;&")))
                    ("spec/command-sub.test.sh"
                     (;; We match KornShell here.
                      ("Making keyword out of command sub should NOT work"
                       ("OK mksh" "OK mksh/gash"))
                      ;; We need an absolute path for Python.
                      ("Command Sub trailing newline removed"
                       ("python" ,(string-append #$python-2 "/bin/python")))
                      ("Command Sub trailing whitespace not removed"
                       ("python" ,(string-append #$python-2 "/bin/python")))
                      ;; This one is Bash specific.
                      ("Command Sub in local sets exit code")
                      ;; We match KornShell here.
                      ("Syntax errors with double quotes within backticks"
                       ("OK mksh STDOUT" "OK mksh/gash STDOUT"))))
                    ("spec/errexit.test.sh"
                     (;; We do not have the time built-in.
                      ("errexit and time { }")
                      ;; Follow Dash on this one.
                      ("errexit with (( ))"
                       ("N-I dash" "N-I dash/gash"))
                      ;; These next two are due to a difference
                      ;; between the Oil shell and every other shell.
                      ;; Oil thinks that setting the errexit option in
                      ;; a context in which it is normally ignored
                      ;; should make it no longer ignored.  We leave
                      ;; it ignored like every other shell.
                      ("setting errexit while it's being ignored")
                      ("setting errexit while it's being ignored in a subshell")
                      ;; We do not do background processes yet.
                      ("background processes respect errexit")))
                    ("spec/glob.test.sh"
                     (;; We do not do tilde expansion yet.
                      ("no glob after ~ expansion")
                      ;; These two are Bash specific.
                      ("store literal globs in array then expand")
                      ("glob inside array")
                      ;; These next two need character classes, which
                      ;; are not yet implemented.
                      ("glob with char class expression")
                      (": escaped")
                      ;; These next four go beyond POSIX.
                      ("shopt -s nullglob")
                      ("shopt -s failglob")
                      ("Don't glob flags on file system with GLOBIGNORE")
                      ("Splitting/Globbing doesn't happen on local assignment")
                      ;; This test is broken.  It relies on '^' to
                      ;; negate bracket expressions, but this is not
                      ;; required by POSIX.  The specified character
                      ;; is '!', so we patch the test.
                      ("Glob of negated unescaped [[] and []]"
                       ("\\[\\^" "[!"))
                      ;; These last two go beyond POSIX.
                      ("PatSub of unescaped [[] and []]")
                      ("PatSub of negated unescaped [[] and []]")))
                    ("spec/loop.test.sh"
                     (;; We do not do tilde expansion yet.
                      ("Tilde expansion within for loop")
                      ;; This is beyond POSIX.
                      ("Brace Expansion within Array"
                       ("N-I dash" "N-I dash/gash"))
                      ;; We match Bash here.
                      ("for loop with invalid identifier"
                       ("OK bash" "OK bash/gash"))
                      ;; For these next two, we do not have arithmetic
                      ;; substitution, but we can use 'expr' instead.
                      ("while in pipe"
                       ("\\$\\(\\(i\\+1\\)\\)" "$(expr $i + 1)"))
                      ("while in pipe with subshell"
                       ("\\$\\(\\(i\\+1\\)\\)" "$(expr $i + 1)"))
                      ;; The Oil shell handles this statically.  We
                      ;; will treat it as a fatal run-time error (for
                      ;; now).
                      ("too many args to continue"
                       ("## status: 2" ,(string-append
                                         "## status: 2\n"
                                         "## OK gash status: 1\n"
                                         "## OK gash STDOUT:\n"
                                         "a\n"
                                         "## END")))))
                    ("spec/quote.test.sh"
                     (;; We match KornShell on these two tests.
                      ("Unterminated single quote"
                       ("OK mksh" "OK mksh/gash"))
                      ("Unterminated double quote"
                       ("OK mksh" "OK mksh/gash"))
                      ;; The rest of these are well beyond POSIX.
                      ("$''")
                      ("$'' with quotes")
                      ("$'' with newlines")
                      ("$'' octal escapes don't have leading 0")
                      ("$'' octal escapes with fewer than 3 chars")
                      ("$\"\"")))
                    ("spec/word-split.test.sh"
                     (;; This test requires local variables, which is
                      ;; a Bash extension.
                      ("IFS is scoped")
                      ;; We do not do tilde expansion yet.
                      ("Tilde sub is not split, but var sub is")
                      ;; These tests rely on 'echo -e', but we can use
                      ;; Guile instead.
                      ("IFS empty doesn't do splitting"
                       ("echo -e ' a b\\\\tc\\\\n'"
                        "guile -c '(display \" a b\\tc\\n\")'"))
                      ("IFS unset behaves like $' \\t\\n'"
                       ("echo -e ' a b\\\\tc\\\\n'"
                        "guile -c '(display \" a b\\tc\\n\")'"))))
                    ("spec/var-sub.test.sh"
                     (;; We match Bash here.
                      ("Bad var sub"
                       ("OK bash" "OK bash/gash"))
                      ;; This test expects 'ls' to be at '/bin/ls',
                      ;; which isn't the case on GuixSD.
                      ("Braced block inside ${}"
                       ("which ls" "guile -c '(display \"/bin/ls\")'"))
                      ;; We match KornShell here.
                      ("Here doc with bad \"$@\" delimiter"
                       ("OK mksh" "OK mksh/gash"))))
                    ("spec/redirect.test.sh"
                     (;; We match Bash and Dash here, just not Oil.
                      ("Redirect in assignment is invalid"
                       ("OK bash" "OK bash/gash"))
                      ;; Again, we match Dash here (though not Bash).
                      ("Redirect in assignment"
                       ("OK dash" "OK dash/gash"))
                      ;; This test requires arithmetic substitutions.
                      ("Redirect in function body is evaluated multiple times")
                      ;; We match KornShell here.
                      ("Prefix redirect for loop -- not allowed"
                       ("OK mksh" "OK mksh/gash"))
                      ;; We do not support named file descriptors
                      ;; (they are not in POSIX).
                      ("Named file descriptor")
                      ;; This requires the errexit option, which we do
                      ;; not use yet.
                      (">| to clobber")
                      ;; This is Bash specific.
                      ("&> redirects stdout and stderr")
                      ;; This seems to go beyond POSIX.
                      ("1>&2- to close file descriptor")
                      ;; Again, this is Bash specific.
                      ("&>> appends stdout and stderr")))
                    ("spec/var-op-strip.test.sh"
                     (;; These tests are Bash specific.
                      ("Remove const suffix is vectorized on user array")
                      ("Remove const suffix is vectorized on $@ array")
                      ("Prepend using replacement of #")
                      ("Append using replacement of %")
                      ;; Character classes are not implemented, but we
                      ;; do have support for ranges.
                      ("Strip char class"
                       ("\\[:alpha:\\]" "a-c"))
                      ;; We follow Dash here.
                      ("Nested % and # operators (bug reported by Crestwave)"
                       ("N-I dash" "N-I dash/gash")))))))
             (for-each (match-lambda
                         ((file tests) (filter-tests tests file)))
                       tests-to-filter)))))))

;; Local Variables:
;; eval: (put 'with-atomic-file-replacement 'scheme-indent-function 1)
;; End:
