guile-examples/shell/guile-shell/test/test-cd.scm

(import
 (fslib)
 (prefix (commands cd) cmd:)
 (shell-state)
 ;; receive form
 (srfi srfi-8)
 (srfi srfi-64))

;; Example from the docs:
;; Initialize and give a name to a simple testsuite.
(test-begin "cd-test")
(test-group "cd-test"
  (define main-directory (getcwd))
  (define test-directory (fsing-join main-directory "test"))
  (define integration-directory
    (fsing-join test-directory "integration"))
  (define default-test-shell-state
    (update-shell-state default-shell-state
                        'current-working-directory
                        integration-directory))

  (test-assert "cd one layer into"
    (begin
      ;; setup for integration tests
      (chdir integration-directory)

      (receive (_ state)
          (cmd:cd "one" #:shell-state default-test-shell-state)
        (let ([expected-dir (fsing-join integration-directory "one")])
          (and (string=? (get-shell-state state 'current-working-directory)
                         expected-dir)
               (string=? (getcwd) expected-dir))))))

  (test-assert "cd one layer into - using previous result"
    (begin
      ;; Setup for integration tests.
      ;; Maybe I should not do this? -- Testing whether the Guile REPL
      ;; tracks the right directory, when using custom procedures.
      (chdir integration-directory)

      (receive (_ state)
          (cmd:cd #:shell-state default-test-shell-state
                  #:previous-result '("one"))
        (let ([expected-dir (fsing-join integration-directory "one")])
          (and (string=? (get-shell-state state 'current-working-directory)
                         expected-dir)
               ;; maybe should not test this?
               (string=? (getcwd) expected-dir))))))

  (test-assert "cd one layer out"
    (let* ([initial-dir (fsing-join integration-directory "one")]
           [initial-shell-state
            (update-shell-state default-test-shell-state
                                'current-working-directory
                                initial-dir)])
      ;; setup for integration tests
      ;; TODO: Should I be doing this?
      (chdir initial-dir)
      (receive (_ state)
          (cmd:cd ".." #:shell-state initial-shell-state)
        (let ([expected-dir integration-directory])
          (and (string=? (get-shell-state state 'current-working-directory)
                         expected-dir)
               (string=? (getcwd) expected-dir))))))

  (test-assert "cd multiple layers into"
    (begin
      ;; setup for integration tests
      (chdir integration-directory)

      (receive (_ state-after-one-cd)
          (cmd:cd "one" #:shell-state default-test-shell-state)
        (receive (_ state-after-two-cd)
            (cmd:cd "two" #:shell-state state-after-one-cd)
          (let ([expected-dir
                 (fsing-join integration-directory
                             "one"
                             "two")])
            (and (string=? (get-shell-state state-after-two-cd
                                            'current-working-directory)
                           expected-dir)
                 (string=? (getcwd) expected-dir)))))))

  (test-assert "cd multiple layers out"
    (let* ([initial-dir (fsing-join integration-directory "one" "two")]
           [initial-shell-state
            (update-shell-state default-test-shell-state
                                'current-working-directory
                                initial-dir)])
      ;; setup for integration tests
      ;; TODO: Should I be doing this?
      (chdir initial-dir)
      (receive (_ state-after-1-cd)
          (cmd:cd ".." #:shell-state initial-shell-state)
        (receive (_ state-after-2-cd)
            (cmd:cd ".." #:shell-state state-after-1-cd)
          (let ([expected-dir integration-directory])
            (and (string=? (get-shell-state state-after-2-cd
                                            'current-working-directory)
                           expected-dir)
                 (string=? (getcwd) expected-dir)))))))

  (test-assert "cd multiple layers out"
    (let* ([initial-dir (fsing-join integration-directory "one" "two")]
           [initial-shell-state
            (update-shell-state default-test-shell-state
                                'current-working-directory
                                initial-dir)])
      ;; setup for integration tests
      ;; TODO: Should I be doing this?
      (chdir initial-dir)
      (receive (_ state-after-cd)
          (cmd:cd "../.." #:shell-state initial-shell-state)
        (let ([expected-dir integration-directory])
            (and (string=? (get-shell-state state-after-cd
                                            'current-working-directory)
                           expected-dir)
                 (string=? (getcwd) expected-dir))))))

  (test-assert "cd here"
    (let* ([initial-dir (fsing-join integration-directory)]
           [initial-shell-state default-test-shell-state])
      ;; setup for integration tests
      ;; TODO: Should I be doing this?
      (chdir initial-dir)
      (receive (_ state-after-cd)
          (cmd:cd "." #:shell-state initial-shell-state)
        (let ([expected-dir initial-dir])
            (and (string=? (get-shell-state state-after-cd
                                            'current-working-directory)
                           expected-dir)
                 (string=? (getcwd) expected-dir)))))))

;; Finish the testsuite, and report results.
(test-end "cd-test")