Source

scsh-process / tests / run.scm

#;(include "../scsh-process.scm")
(use scsh-process)

(use test posix srfi-13 srfi-18 (only setup-api chicken-version version>=?))

(test-begin "scsh-process")

(test-group "Procedural interface"
  (test "Fork/pipe \"hello world\" example from SCSH reference manual"
        '(0 #t "Hello, world.")
        (receive (exit-status exited-ok? pid)
          (wait (fork/pipe
                 (lambda ()
                   (with-output-to-port (open-output-file* 1)
                     (lambda () (display "Hello, world.\n"))))))
          (list exit-status exited-ok? (read-line (open-input-file* 0)))))
  (test "run/string* returns a string output in a subprocess"
        "This is a test"
        (run/string* (lambda () (display "This is a test"))))

  (test-error "run*/string* raises error if subprocess has nonzero exit status"
              (run*/string* (lambda () (display "ohai") (exit 1)))))

(test-group "Macro (EPF) interface"
  (delete-file* "outfile")              ; Leftovers from last run

  (test-group "Various run/... forms"
    (test "Simple run/string"
          "hi, there\n"
          (run/string (echo "hi, there")))

    (test "Simple run/sexp"
          '("hi, there")
          (run/sexp (echo "(\"hi, there\") trailing stuff is ignored")))

    (test "Simple run/sexps"
          '(("hi, there") (a b c))
          (run/sexps (echo "(\"hi, there\") (a b c)")))

    (test "Simple run/port"
          '(a b c)
          (read (run/port (echo "(a b c)"))))

    (let ((tmpfile (run/file (echo "blah"))))
      (test "Simple run/file"
            "blah\n"
            (with-input-from-file tmpfile read-all))

      (test "Appending to a file"
            '("blah" "foo")
            (begin (run (echo foo) (>> ,tmpfile))
                   (read-lines tmpfile)))
      
      (let ((message "testing, 1 2 3"))
        (test "Redirecting from object"
              `("blah" "foo" ,(string-delete #\t message))
              (run/strings (pipe (epf (tr -d t) (<< ,message))
                                 (cat ,tmpfile -)))))
      (delete-file* tmpfile)))

  (test-group "Subprocesses"
    (test "run/string with begin form"
          "hi, there\n"
          (run/string (pipe (begin (print "hi, there")) (cat))))
    (when (version>=? (chicken-version) "4.8.1")
      (let ((child? #f))
        (thread-start! (lambda ()
                         (thread-sleep! 0.5)
                         (when child? (print "haihai"))))
        (test "Simple 'begin' form with threading"
              "hi, there\n"
              (run/string (pipe (begin (set! child? #t)
                                       (thread-sleep! 1)
                                       (print "hi, there"))
                                (cat))))))
    
    (let ((outfile "outfile"))
      (test "Subprocess writing to a file"
            "hi, there\n"
            (begin (run (echo "hi, there") (> ,outfile))
                   (read-all "outfile"))))
  
    (delete-file* "outfile")
    (let ((echo-command 'echo))
      (test "Subprocess piped to another process, writing to a file"
            "1235\n"
            (begin (run (pipe (,echo-command "1234" + 1)
                              ("sh" -c "read foo; echo $(($foo))"))
                        (> outfile))
                   (read-all "outfile"))))
    (delete-file* "outfile")

    (test "Nested output redirection with pipe+"
          "foo\n"
          (run/string (pipe+ ((1 0))
                             (pipe+ ((2 0)) (sh -c "echo foo >&2") (cat))
                             (cat))))

    (test "Collecting FDs"
          (list 0 "foo\n" "bar\n")
          (receive (status port1 port2)
            (run/collecting (2 1) (sh -c "echo foo >&2; echo bar"))
            (list status (read-all port1) (read-all port2)))))

  (test-group "Conditional process sequencing forms"
    (test "&& runs for all true values"
          (list #t "bar\n")
          (list (&& (epf (echo "foo") (> outfile))
                    (true)
                    (epf (echo "bar") (> outfile)))
                (read-all "outfile")))
    (delete-file* "outfile")

    (test "&& stops at first false value and returns false"
          (list #f "foo\n")
          (list (&& (epf (echo "foo") (> outfile))
                    (false)
                    (epf (echo "bar") (> outfile)))
                (read-all "outfile")))
    (delete-file* "outfile")

    (test "|| stops at first true value and returns true"
          (list #t "foo\n")
          (list (|| (epf (echo "foo") (> outfile))
                 (true)
                 (epf (echo "bar") (> outfile)))
                (read-all "outfile")))
    (delete-file* "outfile")

    (test "|| continues after first false value and returns true"
          (list #t "bar\n")
          (list (|| (false)
                 (epf (echo "bar") (> outfile)))
                (read-all "outfile")))
    (delete-file* "outfile")

    (test "|| continues beyond all false values and returns false"
          #f
          (|| (false) (epf (sh -c "echo hi && false") (- 1))))))

(test-group "finalization"
  ;; TODO: Find a way to test that the input port didn't get replaced by
  ;;       one from a subshell.  This happened before, but not sure how
  ;;       to detect this except running it manually from the REPL.
  (test-error "No more zombies lying around after we're done" (wait)))

(test-end)

(test-exit)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.