Commits

evhan committed e5052ca

Test & example updates

  • Participants
  • Parent commits 3d532f1

Comments (0)

Files changed (9)

examples/errorfs.scm

 
 (use fuse posix)
 
-(set-signal-handler! signal/int exit)
-
 (define perm/irwxusr
   (bitwise-ior perm/irusr perm/iwusr perm/ixusr))
 
        (condition->list e)
        (current-error-port)))
     (lambda ()
-      (start-filesystem path fs))))
+      (set-signal-handler! signal/int (lambda (_) (filesystem-stop! path fs)))
+      (filesystem-start! path fs)
+      (filesystem-wait! path fs))))
  (command-line-arguments))

examples/hashfs.scm

 
 (use files posix srfi-1 srfi-13 srfi-69 fuse)
 
-(set-signal-handler! signal/int exit)
-
 ;;
 ;; Copies the contents of string s2 in string s1, beginning at offset
 ;;
              (fprintf (current-error-port) "Finished!\n"))))
 
 (for-each
- (lambda (path) (start-filesystem path fs))
+ (lambda (path)
+   (set-signal-handler! signal/int (lambda (_) (filesystem-stop! path fs)))
+   (filesystem-start! path fs)
+   (filesystem-wait! path fs))
  (command-line-arguments))

examples/hellofs.scm

 
 (use fuse posix)
 
-(set-signal-handler! signal/int exit)
-
 (define hello "Hello world!\n")
 
 (define fs
                  (substring hello offset (min size (- len offset))))))))
 
 (for-each
- (lambda (path) (start-filesystem path fs))
+ (lambda (path)
+   (set-signal-handler! signal/int (lambda (_) (filesystem-stop! path fs)))
+   (filesystem-start! path fs)
+   (filesystem-wait! path fs))
  (command-line-arguments))

examples/portfs.scm

 
 (use fuse posix srfi-13)
 
-(set-signal-handler! signal/int exit)
-
-(let ((mountpoint ; strip CWD if present
-       (let ((arg (car (command-line-arguments))))
-         (cond ((string-prefix? (current-directory) arg)
-                (substring arg (add1 (string-length (current-directory)))))
-               (else arg)))))
-  (start-filesystem
-   mountpoint
-   (make-filesystem
-    getattr: (lambda (path)
-               (let ((path (substring path 1))) ; leading "/"
-                 (cond ((string=? path mountpoint) #f) ; avoid loop
-                       ((string=? path "")
-                        (subvector (file-stat ".") 1 9))
-                       ((file-exists? path)
-                        (subvector (file-stat path) 1 9))
-                       (else #f))))
-    readdir: (lambda (path)
-               (let ((path (substring path 1)))
-                 (cond ((string=? path mountpoint) #f)
-                       ((string=? path "")
-                        (directory "." #t))
-                       ((directory-exists? path)
-                        (directory path #t))
-                       (else #f))))
-    open:    (lambda (path mode)
-               (let ((path (substring path 1)))
-                  (and (regular-file? path)
-                       (open-input-file path))))
-    read:    (lambda (port size _) ; XXX offset ignored
-               (read-string size port))
-    release: (lambda (port)
-               (close-input-port port)))))
+(let* ((mountpoint ; strip CWD if present
+        (let ((arg (car (command-line-arguments))))
+          (cond ((string-prefix? (current-directory) arg)
+                 (substring arg (add1 (string-length (current-directory)))))
+                (else arg))))
+       (filesystem
+        (make-filesystem
+         getattr: (lambda (path)
+                    (let ((path (substring path 1))) ; leading "/"
+                      (cond ((string=? path mountpoint) #f) ; avoid loop
+                            ((string=? path "")
+                             (subvector (file-stat ".") 1 9))
+                            ((file-exists? path)
+                             (subvector (file-stat path) 1 9))
+                            (else #f))))
+         readdir: (lambda (path)
+                    (let ((path (substring path 1)))
+                      (cond ((string=? path mountpoint) #f)
+                            ((string=? path "")
+                             (directory "." #t))
+                            ((directory-exists? path)
+                             (directory path #t))
+                            (else #f))))
+         open:    (lambda (path mode)
+                    (let ((path (substring path 1)))
+                       (and (regular-file? path)
+                            (open-input-file path))))
+         read:    (lambda (port size _) ; XXX offset ignored
+                    (read-string size port))
+         release: (lambda (port)
+                    (close-input-port port)))))
+  (set-signal-handler! signal/int (lambda (_) (filesystem-stop! mountpoint filesystem)))
+  (filesystem-start! mountpoint filesystem)
+  (filesystem-wait! mountpoint filesystem))
 (use fuse posix test)
 
-(set-signal-handler! signal/int exit)
-
 (define u+rwx/reg (bitwise-ior file/reg perm/irusr perm/iwusr perm/ixusr))
 (define u+rwx/dir (bitwise-ior file/dir perm/irusr perm/iwusr perm/ixusr))
 
   (process-wait pid))
 
 (define (test-directories path)
+  (define fs
+    (let ((lst '()))
+      (make-filesystem
+       getattr: (lambda (path)
+                  (and (or (string=? path "/")
+                           (member (substring path 1) lst))
+                       (vector u+rwx/dir
+                               2
+                               (current-user-id)
+                               (current-group-id)
+                               0
+                               (current-seconds)
+                               (current-seconds)
+                               (current-seconds))))
+       readdir: (lambda (path)
+                  (and (string=? path "/")
+                       (append '("." "..") lst)))
+       mkdir:   (lambda (path mode)
+                  (set! lst (cons (substring path 1) lst))))))
   (define pid
     (process-fork
      (lambda ()
-       (set-signal-handler! signal/term exit)
-       (start-filesystem
-        path
-        (let ((lst '()))
-          (make-filesystem
-           getattr: (lambda (path)
-                      (and (or (string=? path "/")
-                               (member (substring path 1) lst))
-                           (vector u+rwx/dir
-                                   2
-                                   (current-user-id)
-                                   (current-group-id)
-                                   0
-                                   (current-seconds)
-                                   (current-seconds)
-                                   (current-seconds))))
-           readdir: (lambda (path)
-                      (and (string=? path "/")
-                           (append '("." "..") lst)))
-           mkdir:   (lambda (path mode)
-                      (set! lst (cons (substring path 1) lst)))))))))
+       (set-signal-handler! signal/term (lambda (_) (filesystem-stop! path fs)))
+       (filesystem-start! path fs)
+       (filesystem-wait! path fs))))
   (sleep 1)
   (let ((num 1000))
     (test-assert (equal? (directory path) '()))
 (define (test-empty path)
   (let ((fs (make-filesystem)))
     (test-assert (not (filesystem-running? path fs)))
-    (thread-start! (lambda () (start-filesystem path fs)))
-    (thread-sleep! 1)
+    (thread-start! (lambda () (filesystem-start! path fs)))
+    (test-assert (filesystem-wait! path fs values))
     (test-assert (filesystem-running? path fs))
     (test-assert (not (filesystem-running? "some-other-path" fs)))
-    (test-assert (stop-filesystem path fs))
-    (test-assert (not (filesystem-running? path fs)))
-    (test-assert (not (stop-filesystem path fs)))))
+    (test-assert (filesystem-stop! path fs))
+    (filesystem-wait! path fs)
+    (test-assert (not (filesystem-stop! path fs)))))
 
 (test-assert (create-directory "path" #t))
 (test-empty "path")
 (use fuse posix test)
 
-(set-signal-handler! signal/int exit)
+(define u+rwx/reg (bitwise-ior file/reg perm/irusr perm/iwusr perm/ixusr))
+(define u+rwx/dir (bitwise-ior file/dir perm/irusr perm/iwusr perm/ixusr))
 
 (define (test-exception path)
   (define pid
-    (process-fork
-     (let ((fs (make-filesystem
-                getattr: (lambda (path)
-                           (cond
-                             ((string=? path "/")
-                              (vector u+rwx/dir
-                                      2
-                                      (current-user-id)
-                                      (current-group-id)
-                                      0
-                                      (current-seconds)
-                                      (current-seconds)
-                                      (current-seconds)))
-                             ((string=? path "/error")
-                              (vector u+rwx/reg
-                                      1
-                                      (current-user-id)
-                                      (current-group-id)
-                                      0
-                                      (current-seconds)
-                                      (current-seconds)
-                                      (current-seconds)))
-                             (else #f)))
-                readdir: (lambda (path)
-                           (and (string=? path "/")
-                                (list "." ".." "error")))
-                open:    (lambda (path mode)
-                           (error 'open "Error opening path" path mode)))))
+   (let ((fs (make-filesystem
+              getattr: (lambda (path)
+                         (cond
+                           ((string=? path "/")
+                            (vector u+rwx/dir
+                                    2
+                                    (current-user-id)
+                                    (current-group-id)
+                                    0
+                                    (current-seconds)
+                                    (current-seconds)
+                                    (current-seconds)))
+                           ((string=? path "/error")
+                            (vector u+rwx/reg
+                                    1
+                                    (current-user-id)
+                                    (current-group-id)
+                                    0
+                                    (current-seconds)
+                                    (current-seconds)
+                                    (current-seconds)))
+                           (else #f)))
+              readdir: (lambda (path)
+                         (and (string=? path "/")
+                              (list "." ".." "error")))
+              open:    (lambda (path mode)
+                         (error 'open "Error opening path" path mode)))))
+      (process-fork
        (lambda ()
-         (with-exception-handler
-          (lambda (e)
-            (stop-filesystem path fs)
-            (exit 42))
-          (lambda ()
-            (start-filesystem path fs)))))))
+         (set-signal-handler! signal/term (lambda (_) (filesystem-stop! path fs)))
+         (let ((n 0))
+           (with-exception-handler
+            (lambda (e)
+              (set! n (add1 n)))
+            (lambda ()
+              (filesystem-start! path fs)
+              (filesystem-wait! path fs)
+              (exit n))))))))
   (sleep 1)
   (let ((file (string-append path "/error")))
-    (test-error (read-file file))
-    (let-values (((_ _ exit-status) (process-wait pid)))
-      (test-assert (equal? exit-status 42)))))
+    (do ((n 0 (add1 n)))
+        ((= n 10)
+         (process-signal pid signal/term)
+         (let-values (((_ _ exit-status)
+                       (process-wait pid)))
+           (test-assert (>= exit-status n))))
+      (test-error (file-open file open/read)))))
 
 (test-assert (create-directory "path" #t))
 (test-exception "path")
 (use fuse posix test)
 
-(set-signal-handler! signal/int exit)
-
 (define u+rwx/reg (bitwise-ior file/reg perm/irusr perm/iwusr perm/ixusr))
 (define u+rwx/dir (bitwise-ior file/dir perm/irusr perm/iwusr perm/ixusr))
 
 (define (test-hello path)
   (define str "Hello world!\n")
   (define now (current-seconds))
+  (define fs
+    (make-filesystem
+     getattr: (lambda (path)
+                (cond
+                  ((string=? path "/")
+                   (vector u+rwx/dir
+                           2
+                           (current-user-id)
+                           (current-group-id)
+                           0
+                           (current-seconds)
+                           now
+                           now))
+                  ((string=? path "/hello")
+                   (vector u+rwx/reg
+                           1
+                           (current-user-id)
+                           (current-group-id)
+                           (string-length str)
+                           (current-seconds)
+                           now
+                           now))
+                  (else #f)))
+     readdir: (lambda (path)
+                (and (string=? path "/")
+                     (list "." ".." "hello")))
+     open:    (lambda (path mode)
+                (string=? path "/hello"))
+     read:    (lambda (_ size offset)
+                (let ((len (string-length str)))
+                  (if (>= offset len)
+                      0
+                      (substring str offset (min size (- len offset))))))))
   (define pid
     (process-fork
      (lambda ()
-       (set-signal-handler! signal/term exit)
-       (start-filesystem
-        path
-        (make-filesystem
-         getattr: (lambda (path)
-                    (cond ((string=? path "/")
-                           (vector u+rwx/dir
-                                   2
-                                   (current-user-id)
-                                   (current-group-id)
-                                   0
-                                   (current-seconds)
-                                   now
-                                   now))
-                          ((string=? path "/hello")
-                           (vector u+rwx/reg
-                                   1
-                                   (current-user-id)
-                                   (current-group-id)
-                                   (string-length str)
-                                   (current-seconds)
-                                   now
-                                   now))
-                          (else #f)))
-         readdir: (lambda (path)
-                    (and (string=? path "/")
-                         (list "." ".." "hello")))
-         open:    (lambda (path mode)
-                    (string=? path "/hello"))
-         read:    (lambda (path size offset)
-                    (let ((len (string-length str)))
-                      (if (>= offset len)
-                          0
-                          (substring str offset (min size (- len offset)))))))))))
+       (set-signal-handler! signal/term (lambda (_) (filesystem-stop! path fs)))
+       (filesystem-start! path fs)
+       (filesystem-wait! path fs))))
   (sleep 1)
   (let* ((file (string-append path "/hello"))
          (now* (current-seconds))

tests/unmount.scm

          (fs (make-filesystem)))
      (test-assert (create-directory path #t))
      (test-assert (not (filesystem-running? path fs)))
-     (thread-start! (lambda () (start-filesystem path fs)))
-     (thread-sleep! 1)
+     (thread-start! (lambda () (filesystem-start! path fs)))
+     (test-assert (filesystem-wait! path fs values))
      (test-assert (filesystem-running? path fs))
      (test-assert (zero? (system (format "fusermount -u ~a" path))))
-     (test-assert (not (filesystem-running? path fs)))
-     (test-assert (stop-filesystem path fs))
-     (test-assert (not (stop-filesystem path fs)))
+     (test-assert (filesystem-stop! path fs))
+     (test-assert (filesystem-wait! path fs))
+     (test-assert (not (filesystem-stop! path fs)))
      (test-assert (delete-directory path #t)))))