fix akku.sls and reset test-workspace.sps

ufo5260987423 · Nov 22, 2023 · d2f80b9 · d2f80b9
1 parent 31b2660
commit d2f80b9
Show file tree

Hide file tree

Showing 2 changed files with 47 additions and 45 deletions.
diff --git a/analysis/package-manager/akku.sls b/analysis/package-manager/akku.sls
@@ -12,14 +12,15 @@
       [akku-path (string-append root ".akku")]
       [akku-lib-path (string-append root ".akku/lib")]
       [path->library (make-hashtable string-hash equal?)])
-    (map 
-      (lambda (line) 
-        (let* ([first-tab-index (string-index line #\tab)]
-            [second-tab-index (string-index line #\tab (+ 1 first-tab-index))]
-            [target-path (string-drop-right line (- (string-length line) first-tab-index))]
-            [target-library (string-drop (string-drop-right line (- (string-length line) second-tab-index)) (+ 1 first-tab-index))])
-          (hashtable-set! path->library (string-append root target-path) target-library))) 
-      (read-lines list-path))
+    (if (file-exists? list-path)
+      (map 
+        (lambda (line) 
+          (let* ([first-tab-index (string-index line #\tab)]
+              [second-tab-index (string-index line #\tab (+ 1 first-tab-index))]
+              [target-path (string-drop-right line (- (string-length line) first-tab-index))]
+              [target-library (string-drop (string-drop-right line (- (string-length line) second-tab-index)) (+ 1 first-tab-index))])
+            (hashtable-set! path->library (string-append root target-path) target-library))) 
+        (read-lines list-path)))
     (lambda (path)
       (cond 
         [(string-contains path "/.git/") #f]

diff --git a/tests/analysis/test-workspace.sps b/tests/analysis/test-workspace.sps
@@ -19,47 +19,48 @@
     (scheme-langserver analysis identifier reference)
     (scheme-langserver analysis identifier rules library-import))
 
-; (test-begin "init-virtual-file-system")
-;     (test-equal "scheme-langserver.sls" 
-;         (find (lambda(n) (equal? n "scheme-langserver.sls")) 
-;         (map file-node-name (file-node-children (init-virtual-file-system (current-directory) '() akku-acceptable-file?)))))
-; (test-end)
+(test-begin "init-virtual-file-system")
+    (test-equal "scheme-langserver.sls" 
+        (find (lambda(n) (equal? n "scheme-langserver.sls")) 
+        (map file-node-name 
+            (file-node-children (init-virtual-file-system (current-directory) '() (generate-akku-acceptable-file-filter (string-append (current-directory) "/.akku/list")))))))
+(test-end)
 
-; (test-begin "init-index-node")
-;     (test-equal 'library 
-;         (annotation-stripped 
-;             (car 
-;                 (annotation-expression 
-;                 (index-node-datum/annotations
-;                     (init-index-node '() (car (source-file->annotations "./util/io.sls"))))))))
-; (test-end)
+(test-begin "init-index-node")
+    (test-equal 'library 
+        (annotation-stripped 
+            (car 
+                (annotation-expression 
+                (index-node-datum/annotations
+                    (init-index-node '() (car (source-file->annotations "./util/io.sls"))))))))
+(test-end)
 
-; (test-begin "init-library-node")
-;     (let* ( [root-file-node (init-virtual-file-system "./util/" '() akku-acceptable-file?)]
-;             [root-library-node (init-library-node root-file-node)])
-;         (test-equal 'scheme-langserver (library-node-name (car (library-node-children root-library-node)))))
-; (test-end)
+(test-begin "init-library-node")
+    (let* ( [root-file-node (init-virtual-file-system "./util/" '() (generate-akku-acceptable-file-filter (string-append "./util" "/.akku/list")))]
+            [root-library-node (init-library-node root-file-node)])
+        (test-equal 'scheme-langserver (library-node-name (car (library-node-children root-library-node)))))
+(test-end)
 
-; (test-begin "pick-test")
-;     (test-equal 'library 
-;         (annotation-stripped 
-;             (index-node-datum/annotations 
-;             (car (pick (init-index-node '() (car (source-file->annotations "./util/path.sls"))) 0 8)))))
-; (test-end)
+(test-begin "pick-test")
+    (test-equal 'library 
+        (annotation-stripped 
+            (index-node-datum/annotations 
+            (car (pick (init-index-node '() (car (source-file->annotations "./util/path.sls"))) 0 8)))))
+(test-end)
 
-; (test-begin "refresh-workspace-for+update-file-node-with-tail test")
-;     (let* ([workspace (init-workspace (string-append (current-directory) "/util/"))]
-;             [root-file-node (workspace-file-node workspace)]
-;             [root-library-node (workspace-library-node workspace)]
-;             [target-file-node (walk-file root-file-node (string-append (current-directory) "/util/natural-order-compare.sls"))])
-;         (update-file-node-with-tail 
-;             workspace
-;             target-file-node 
-;             "(library (scheme-langserver util natural-order-compare1)\n    (export natural-order-compare)\n    (import (rnrs) )\n\n(define natural-order-compare \n    (case-lambda \n        [(string-a string-b) (natural-order-compare string-a string-b 0 0)] \n        [(string-a string-b index-a index-b) \n            (let ([length-a (string-length string-a)] \n                    [length-b (string-length string-b)]) \n                (if (or (>= index-a length-a) \n                        (>= index-b length-b)) \n                    (< length-a length-b) \n                    (let ([char-a (string-ref string-a index-a)] \n                            [char-b (string-ref string-b index-b)]) \n                        (if (char=? char-a char-b) \n                            (natural-order-compare string-a string-b (+ 1 index-a) (+ 1 index-b)) \n                            (char<? char-a char-b)))))])) \n)"
-;             )
-;         (refresh-workspace-for workspace target-file-node)
-;         (test-equal #f (null? (walk-library '(scheme-langserver util natural-order-compare1) root-library-node))))
-; (test-end)
+(test-begin "refresh-workspace-for+update-file-node-with-tail test")
+    (let* ([workspace (init-workspace (string-append (current-directory) "/util/"))]
+            [root-file-node (workspace-file-node workspace)]
+            [root-library-node (workspace-library-node workspace)]
+            [target-file-node (walk-file root-file-node (string-append (current-directory) "/util/natural-order-compare.sls"))])
+        (update-file-node-with-tail 
+            workspace
+            target-file-node 
+            "(library (scheme-langserver util natural-order-compare1)\n    (export natural-order-compare)\n    (import (rnrs) )\n\n(define natural-order-compare \n    (case-lambda \n        [(string-a string-b) (natural-order-compare string-a string-b 0 0)] \n        [(string-a string-b index-a index-b) \n            (let ([length-a (string-length string-a)] \n                    [length-b (string-length string-b)]) \n                (if (or (>= index-a length-a) \n                        (>= index-b length-b)) \n                    (< length-a length-b) \n                    (let ([char-a (string-ref string-a index-a)] \n                            [char-b (string-ref string-b index-b)]) \n                        (if (char=? char-a char-b) \n                            (natural-order-compare string-a string-b (+ 1 index-a) (+ 1 index-b)) \n                            (char<? char-a char-b)))))])) \n)"
+            )
+        (refresh-workspace-for workspace target-file-node)
+        (test-equal #f (null? (walk-library '(scheme-langserver util natural-order-compare1) root-library-node))))
+(test-end)
 
 (test-begin "library-import-process")
     (let* ( [workspace (init-workspace (current-directory) #f #t #f)]