]> gitweb.factorcode.org Git - factor.git/blob - basis/io/files/windows/windows-tests.factor
io.files: exists? -> file-exists? and rename primitive.
[factor.git] / basis / io / files / windows / windows-tests.factor
1 ! Copyright (C) 2010 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators continuations io.backend io.directories io.files
4 io.files.temp io.files.windows io.pathnames kernel kernel.private libc
5 literals memory sequences splitting tools.test windows.kernel32
6 io.files.unique destructors ;
7
8 [ f ] [ "\\foo" absolute-path? ] unit-test
9 [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
10 [ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test
11 [ t ] [ "\\\\?\\c:" absolute-path? ] unit-test
12 [ t ] [ "c:\\foo" absolute-path? ] unit-test
13 [ t ] [ "c:" absolute-path? ] unit-test
14 [ t ] [ "c:\\" absolute-path? ] unit-test
15 [ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test
16
17 [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
18 [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
19 [ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
20 ! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
21 [ "c:\\" ] [ "c:\\" parent-directory ] unit-test
22 [ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test
23 [ "c:" ] [ "c:" parent-directory ] unit-test
24 [ "Z:" ] [ "Z:" parent-directory ] unit-test
25
26 [ f ] [ "" root-directory? ] unit-test
27 [ t ] [ "\\" root-directory? ] unit-test
28 [ t ] [ "\\\\" root-directory? ] unit-test
29 [ t ] [ "/" root-directory? ] unit-test
30 [ t ] [ "//" root-directory? ] unit-test
31 [ t ] [ "c:\\" trim-tail-separators root-directory? ] unit-test
32 [ t ] [ "Z:\\" trim-tail-separators root-directory? ] unit-test
33 [ f ] [ "c:\\foo" root-directory? ] unit-test
34 [ f ] [ "." root-directory? ] unit-test
35 [ f ] [ ".." root-directory? ] unit-test
36 [ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test
37 [ t ] [ "\\\\?\\c:" root-directory? ] unit-test
38 [ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test
39
40 [ "\\\\a\\b\\c\\foo.xls" ] [ "//a/b/c/foo.xls" normalize-path ] unit-test
41 [ "\\\\a\\b\\c\\foo.xls" ] [ "\\\\a\\b\\c\\foo.xls" normalize-path ] unit-test
42
43 [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
44
45 [ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
46     "C:\\builds\\factor\\12345\\"
47     "..\\log.txt" append-path normalize-path
48 ] unit-test
49
50 [ "\\\\?\\C:\\builds\\" ] [
51     "C:\\builds\\factor\\12345\\"
52     "..\\.." append-path normalize-path
53 ] unit-test
54
55 [ "\\\\?\\C:\\builds\\" ] [
56     "C:\\builds\\factor\\12345\\"
57     "..\\.." append-path normalize-path
58 ] unit-test
59
60 [ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
61 [ t ] [ "" resource-path 2 tail file-exists? ] unit-test
62
63 ! win32-file-attributes
64 {
65     { +read-only+ +hidden+ }
66 } [
67     3 win32-file-attributes
68 ] unit-test
69
70 ! set-file-attributes & save-image
71 { ${ KERNEL-ERROR ERROR-IO EIO f } } [
72     [
73         "read-only.image" temp-file {
74             [ ?delete-file ]
75             [ touch-file ]
76             [ FILE_ATTRIBUTE_READONLY set-file-attributes ]
77             [ save-image ]
78         } cleave
79     ] [ ] recover
80 ] unit-test
81
82 ! test that we can open a shared file
83 ! https://github.com/factor/factor/pull/1636
84 { } [
85     "open-file-" "-test.txt" [
86         [ open-write ] [ open-read ] bi [ dispose ] bi@
87     ] cleanup-unique-file
88 ] unit-test