Merge branch 'master' of git://factorcode.org/git/factor

basis/io/unix/files/macosx/macosx.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types alien.strings combinators
 grouping io.encodings.utf8 io.files kernel math sequences
-system unix io.unix.files
+system unix io.unix.files specialized-arrays.direct.uint arrays
 unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx ;
 IN: io.unix.files.macosx
 
@@ -33,7 +33,7 @@ M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-i
         [ statfs64-f_bavail >>blocks-available ]
         [ statfs64-f_files >>files ]
         [ statfs64-f_ffree >>files-free ]
-        [ statfs64-f_fsid >>id ]
+        [ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
         [ statfs64-f_owner >>owner ]
         [ statfs64-f_type >>type-id ]
         [ statfs64-f_flags >>flags ]

basis/io/windows/files/files.factor

@@ -5,7 +5,7 @@ io.encodings.utf16n io.ports io.windows kernel math splitting
 fry alien.strings windows windows.kernel32 windows.time calendar
 combinators math.functions sequences namespaces make words
 symbols system destructors accessors math.bitwise continuations
-windows.errors arrays byte-arrays ;
+windows.errors arrays byte-arrays generalizations ;
 IN: io.windows.files
 
 : open-file ( path access-mode create-mode flags -- handle )
@@ -117,7 +117,7 @@ M: windows delete-directory ( path -- )
 : find-first-file ( path -- WIN32_FIND_DATA handle )
     "WIN32_FIND_DATA" <c-object> tuck
     FindFirstFile
-    [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
+    [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
 
 : find-next-file ( path -- WIN32_FIND_DATA/f )
     "WIN32_FIND_DATA" <c-object> tuck
@@ -257,13 +257,15 @@ M: winnt link-info ( path -- info )
 
 HOOK: root-directory os ( string -- string' )
 
-: file-system-type ( normalized-path -- str )
+: volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
-    MAX_PATH 1+ <byte-array>
+    MAX_PATH 1+ [ <byte-array> ] keep
-    MAX_PATH 1+
+    "DWORD" <c-object>
-    "DWORD" <c-object> "DWORD" <c-object> "DWORD" <c-object>
+    "DWORD" <c-object>
-    MAX_PATH 1+ <byte-array>
+    "DWORD" <c-object>
-    MAX_PATH 1+
+    MAX_PATH 1+ [ <byte-array> ] keep
-    [ GetVolumeInformation win32-error=0/f ] 2keep drop
+    [ GetVolumeInformation win32-error=0/f ] 7 nkeep
+    drop 5 nrot drop
+    [ utf16n alien>string ] 4 ndip
     utf16n alien>string ;
 
 : file-system-space ( normalized-path -- available-space total-space free-space )
@@ -278,14 +280,20 @@ HOOK: root-directory os ( string -- string' )
         [ ]
     } cleave ;
 
+TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ;
+
 M: winnt file-system-info ( path -- file-system-info )
     normalize-path root-directory
-    dup [ file-system-type ] [ file-system-space ] bi
+    dup [ volume-information ] [ file-system-space ] bi
-    \ file-system-info new
+    \ win32-file-system-info new
         swap *ulonglong >>free-space
         swap *ulonglong >>total-space
         swap *ulonglong >>available-space
         swap >>type
+        swap *uint >>flags
+        swap *uint >>max-component
+        swap *uint >>device-serial
+        swap >>device-name
         swap >>mount-point
     calculate-file-system-info ;
 
@@ -299,16 +307,16 @@ M: winnt file-system-info ( path -- file-system-info )
     ] if ;
 
 : find-first-volume ( -- string handle )
-    MAX_PATH 1+ <byte-array> dup length
+    MAX_PATH 1+ [ <byte-array> ] keep
     dupd
     FindFirstVolume dup win32-error=0/f
     [ utf16n alien>string ] dip ;
 
 : find-next-volume ( handle -- string/f )
-    MAX_PATH 1+ <byte-array> dup length
+    MAX_PATH 1+ [ <byte-array> tuck ] keep
-    over [ FindNextVolume ] dip swap 0 = [
+    FindNextVolume 0 = [
         GetLastError ERROR_NO_MORE_FILES =
-        [ drop f ] [ win32-error ] if
+        [ drop f ] [ win32-error-string throw ] if
     ] [
         utf16n alien>string
     ] if ;

basis/tools/files/files-tests.factor

@@ -7,5 +7,4 @@ IN: tools.files.tests
 
 [ ] [ "" directory. ] unit-test
 
-[ ]
+[ ] [ file-systems. ] unit-test
-[ { device-name free-space used-space total-space percent-used } file-systems. ] unit-test

basis/tools/files/files.factor

@@ -58,10 +58,14 @@ percent-used percent-free ;
 : file-systems-info ( spec -- seq )
     file-systems swap '[ _ [ file-system-spec ] with map ] map ;
 
-: file-systems. ( spec -- )
+: print-file-systems ( spec -- )
     [ file-systems-info ]
     [ [ unparse ] map ] bi prefix simple-table. ;
 
+: file-systems. ( -- )
+    { device-name free-space used-space total-space percent-used }
+    print-file-systems ;
+
 {
     { [ os unix? ] [ "tools.files.unix" ] }
     { [ os windows? ] [ "tools.files.windows" ] }