path-utils: Test fallback when directory from preference is deleted.

Author: LiberalArtist

gui-test/framework/tests/path-utils.rkt

@@ -10,6 +10,9 @@
          racket/contract/base
          framework/preferences)
 
+;; For uniform comparisons, all tests use simplified paths normalized
+;; with path->directory-path when applicable.
+
 (define (path-base pth)
   (define-values (base name dir?)
     (split-path pth))
@@ -30,61 +33,95 @@
       (preferences:get/set 'path-utils:autosave-dir))
     (define elem
       (bytes->path-element #"example.rkt"))
-    (define dir
+    (define current-dir
       (path->directory-path
        (simplify-path (current-directory))))
     (define complete
-      (build-path dir elem))
+      ; don't put the complete path in (current-directory) directly
+      ; so that we can test that the functions don't just always use (current-directory)
+      (build-path current-dir "somewhere" elem))
+    (define dir-of-complete
+      (path-base complete))
     ;; Tests with #f for directories
     (current-backup-dir #f)
     (current-autosave-dir #f)
-    (check-equal? (path-base (simplify-path(generate-autosave-name #f)))
-                  (path->directory-path (find-system-path 'doc-dir)))
-    (check-equal? (path-base (simplify-path (generate-autosave-name elem)))
-                  dir)
-    (check-equal? (path-base (generate-autosave-name complete))
-                  dir)
-    (check-equal? (path-base (simplify-path (generate-backup-name elem)))
-                  dir)
-    (check-equal? (path-base (generate-backup-name complete))
-                  dir)
+    (with-check-info (['path-utils:backup-dir (current-backup-dir)]
+                      ['path-utils:autosave-dir (current-autosave-dir)])
+      (with-check-info (['|generate- function| (string-info "generate-autosave-name")])
+        (check-equal? (path-base (simplify-path (generate-autosave-name #f)))
+                      (path->directory-path (find-system-path 'doc-dir))
+                      "no orig name should use 'doc-dir")
+        (check-equal? (path-base (simplify-path (generate-autosave-name elem)))
+                      current-dir
+                      "should resolve relative using current directory")
+        (check-equal? (path-base (generate-autosave-name complete))
+                      dir-of-complete
+                      "complete path should use that directory"))
+      (with-check-info (['|generate- function| (string-info "generate-backup-name")])
+        (check-equal? (path-base (simplify-path (generate-backup-name elem)))
+                      current-dir
+                      "should resolve relative using current directory")
+        (check-equal? (path-base (generate-backup-name complete))
+                      dir-of-complete
+                      "complete path should use that directory")))
     ;; Tests with designated directories
-    (define backup-dir
+    (define (make-temp-directory/normalize-path fmt-str)
       (path->directory-path
        (simplify-path
-        (make-temporary-file "rkt-backup-dir-~a"
-                             'directory))))
+        (make-temporary-file fmt-str 'directory))))
+    (define backup-dir
+      (make-temp-directory/normalize-path "rkt-backup-dir-~a"))
     (define autosave-dir
-      (path->directory-path
-      (simplify-path
-       (make-temporary-file "rkt-autosave-dir-~a"
-                            'directory))))
+      (make-temp-directory/normalize-path "rkt-autosave-dir-~a"))
     (dynamic-wind
      void
      (λ () 
        (current-backup-dir backup-dir)
        (current-autosave-dir autosave-dir)
-       (check-equal? (path-base (generate-autosave-name #f))
-                     autosave-dir)
-       (check-equal? (path-base (generate-autosave-name elem))
-                     autosave-dir)
-       (check-equal? (path-base (generate-autosave-name complete))
-                     autosave-dir)
-       (check-equal? (path-base (generate-backup-name elem))
-                     backup-dir)
-       (check-equal? (path-base (generate-backup-name complete))
-                     backup-dir)
        (define clashing-name
-         (build-path dir "elsewhere" elem))
-       (check-false
-        (equal? (simplify-path (generate-autosave-name complete))
-                (simplify-path (generate-autosave-name clashing-name))))
-       (check-false
-        (equal? (simplify-path (generate-backup-name complete))
-                (simplify-path (generate-backup-name clashing-name)))))
+         (build-path current-dir "elsewhere" elem))
+       (with-check-info (['path-utils:backup-dir (current-backup-dir)]
+                         ['path-utils:autosave-dir (current-autosave-dir)])
+         (with-check-info (['|generate- function| (string-info "generate-autosave-name")])
+           (check-equal? (path-base (generate-autosave-name #f))
+                         autosave-dir
+                         "no orig name should use autosave dir")
+           (check-equal? (path-base (generate-autosave-name elem))
+                         autosave-dir
+                         "relative path should use autosave dir")
+           (check-equal? (path-base (generate-autosave-name complete))
+                         autosave-dir
+                         "complete path should use autosave dir")
+           (check-false
+            (equal? (simplify-path (generate-autosave-name complete))
+                    (simplify-path (generate-autosave-name clashing-name)))
+            "files with the same name in different directories should not collide")
+           ; delete
+           (delete-directory autosave-dir)
+           (check-equal? (path-base (generate-autosave-name complete))
+                         dir-of-complete
+                         "should fall back when autosave dir deleted"))
+         (with-check-info (['|generate- function| (string-info "generate-backup-name")])
+           (check-equal? (path-base (generate-backup-name elem))
+                         backup-dir
+                         "relative path should use backup dir")
+           (check-equal? (path-base (generate-backup-name complete))
+                         backup-dir
+                         "complete path should use backup dir")
+           (check-false
+            (equal? (simplify-path (generate-backup-name complete))
+                    (simplify-path (generate-backup-name clashing-name)))
+            "files with the same name in different directories should not collide")
+           ; delete
+           (delete-directory backup-dir)
+           (check-equal? (path-base (generate-backup-name complete))
+                         dir-of-complete
+                         "should fall back when backup dir deleted"))))
      (λ ()
-       (delete-directory backup-dir)
-       (delete-directory autosave-dir)))))
+       (when (directory-exists? backup-dir)
+         (delete-directory backup-dir))
+       (when (directory-exists? autosave-dir)
+         (delete-directory autosave-dir))))))