]> gitweb.factorcode.org Git - factor.git/commitdiff
io.files.info: Fix linux file-system-info recursion
authorDoug Coleman <doug.coleman@gmail.com>
Sun, 5 Jan 2020 19:16:12 +0000 (13:16 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 5 Jan 2020 19:27:22 +0000 (13:27 -0600)
basis/io/files/info/info.factor
basis/io/files/info/unix/linux/linux.factor
extra/mason/disk/disk.factor

index 95da980649fbccb3aa337c85bdcad488a3d1c2ae..57546b6ca93e81a74ac638614de23b51851b2aff 100644 (file)
@@ -39,17 +39,16 @@ HOOK: mount-points os ( -- assoc )
 M: object mount-points
     file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
 
-: (find-mount-point) ( path assoc -- path )
+: (find-mount-point) ( path assoc -- object )
     [ resolve-symlinks canonicalize-path-full ] dip
     2dup at* [
         2nip
     ] [
-        drop [ parent-directory ] dip
-        (find-mount-point)
+        drop [ parent-directory ] dip (find-mount-point)
     ] if ;
 
-: find-mount-point ( path -- path' )
-    mount-points (find-mount-point) mount-point>> ;
+: find-mount-point ( path -- object )
+    mount-points (find-mount-point) ;
 
 {
     { [ os unix? ] [ "io.files.info.unix" ] }
index e179354685a15c499af1b731f68372cb2517de56..52948eccc76be2435cba7da0eb949563f22a4d74 100644 (file)
@@ -68,9 +68,15 @@ frequency pass-number ;
     CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
     [ mtab-csv>mtab-entry ] map ;
 
+: (file-system-info) ( path -- file-system-info )
+    [ new-file-system-info ] dip
+    [ file-system-statfs statfs>file-system-info ]
+    [ file-system-statvfs statvfs>file-system-info ] bi
+    file-system-calculations ; inline
+
 : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
     '[
-        _ [ mount-point>> file-system-info ] keep
+        _ [ mount-point>> (file-system-info) ] [ ] bi
         {
             [ file-system-name>> >>device-name ]
             [ mount-point>> >>mount-point ]
@@ -85,14 +91,8 @@ M: linux file-systems
     parse-mtab [ mtab-entry>file-system-info ] map sift ;
 
 M: linux file-system-info ( path -- file-system-info )
-    normalize-path
-    [
-        [ new-file-system-info ] dip
-        [ file-system-statfs statfs>file-system-info ]
-        [ file-system-statvfs statvfs>file-system-info ] bi
-        file-system-calculations
-    ] keep
-    find-mount-point-info
+    normalize-path [ (file-system-info) ] [ ] bi
+    find-mount-point
     {
         [ file-system-name>> >>device-name drop ]
         [ mount-point>> >>mount-point drop ]
index 97e48ff88d149e5024c1600e052e2147cc127ec0..a80556cd1642e33e5d28ede890389bcdd9d042ad 100644 (file)
@@ -7,7 +7,7 @@ IN: mason.disk
 : Gi ( n -- gibibits ) 30 2^ * ; inline
 
 : sufficient-disk-space? ( -- ? )
-    current-directory get find-mount-point
+    current-directory get find-mount-point mount-point>>
     file-system-info available-space>> 1 Gi > ;
 
 : check-disk-space ( -- )
@@ -18,7 +18,7 @@ IN: mason.disk
 : Gi-str ( n -- string ) 1 Gi /f ;
 
 : path>disk-usage ( path -- string )
-    find-mount-point file-system-info
+    find-mount-point mount-point>> file-system-info
     [ used-space>> ] [ available-space>> ] [ total-space>> ] tri
     2dup /f 100 *
     [ [ Gi-str ] tri@ ] dip