Skip to content

Commit 8b0b7c5

Browse files
committed
Test using normal filename concat without trying to normalize ./foo.
1 parent 8485a06 commit 8b0b7c5

File tree

8 files changed

+35
-49
lines changed

8 files changed

+35
-49
lines changed

analysis/.depend

+3-3
Original file line numberDiff line numberDiff line change
@@ -10,9 +10,9 @@ src/FindFiles.cmx : src/Utils.cmx src/SharedTypes.cmx \
1010
src/Files.cmx src/BuildSystem.cmx
1111
src/Hover.cmx : src/Utils.cmx src/SharedTypes.cmx src/Shared.cmx \
1212
src/References.cmx src/ProcessCmt.cmx
13-
src/Infix.cmx : src/Log.cmx src/Files.cmx
13+
src/Infix.cmx : src/Log.cmx
1414
src/Log.cmx :
15-
src/ModuleResolution.cmx : src/Infix.cmx src/Files.cmx
15+
src/ModuleResolution.cmx : src/Files.cmx
1616
src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \
1717
src/Shared.cmx src/Protocol.cmx src/ProcessCmt.cmx src/PartialParser.cmx \
1818
src/Log.cmx src/Infix.cmx src/Hover.cmx
@@ -33,7 +33,7 @@ src/References.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \
3333
src/Shared.cmx : src/PrintType.cmx src/Files.cmx
3434
src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx \
3535
src/Infix.cmx
36-
src/Uri2.cmx : src/Files.cmx
36+
src/Uri2.cmx :
3737
src/Utils.cmx : src/Protocol.cmx
3838
src/vendor/Json.cmx :
3939
src/vendor/res_outcome_printer/res_comment.cmx : \

analysis/src/BuildSystem.ml

+5-5
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
11
let namespacedName namespace name =
2-
match namespace with
3-
| None -> name
4-
| Some namespace -> name ^ "-" ^ namespace
2+
match namespace with None -> name | Some namespace -> name ^ "-" ^ namespace
53

64
open Infix
75

@@ -21,9 +19,11 @@ let getBsPlatformDir rootPath =
2119
Log.log message;
2220
Error message
2321

24-
let getCompiledBase root = Files.ifExists (root /+ "lib" /+ "bs")
22+
let getCompiledBase root =
23+
Files.ifExists (Filename.concat (Filename.concat root "lib") "bs")
2524

2625
let getStdlib base =
2726
match getBsPlatformDir base with
2827
| Error e -> Error e
29-
| Ok bsPlatformDir -> Ok (bsPlatformDir /+ "lib" /+ "ocaml")
28+
| Ok bsPlatformDir ->
29+
Ok (Filename.concat (Filename.concat bsPlatformDir "lib") "ocaml")

analysis/src/Files.ml

-14
Original file line numberDiff line numberDiff line change
@@ -97,17 +97,3 @@ let rec collect ?(checkDir = fun _ -> true) path test =
9797
|> List.concat
9898
else []
9999
| _ -> if test path then [path] else []
100-
101-
let fileConcat a b =
102-
if
103-
b <> ""
104-
&& b.[0] = '.'
105-
&& String.length b >= 2
106-
&& b.[1] = Filename.dir_sep.[0]
107-
then Filename.concat a (String.sub b 2 (String.length b - 2))
108-
else Filename.concat a b
109-
110-
let isFullPath b =
111-
b.[0] = '/' || (Sys.win32 && String.length b > 1 && b.[1] = ':')
112-
113-
let maybeConcat a b = if b <> "" && isFullPath b then b else fileConcat a b

analysis/src/FindFiles.ml

+20-18
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,15 @@ let ifDebug debug name fn v =
44
if debug then Log.log (name ^ ": " ^ fn v);
55
v
66

7+
let ( ++ ) = Filename.concat
8+
79
(* Returns a list of paths, relative to the provided `base` *)
810
let getSourceDirectories ~includeDev base config =
911
let rec handleItem current item =
1012
match item with
1113
| Json.Array contents ->
1214
List.map (handleItem current) contents |> List.concat
13-
| Json.String text -> [current /+ text]
15+
| Json.String text -> [current ++ text]
1416
| Json.Object _ -> (
1517
let dir =
1618
Json.get "dir" item |?> Json.string |? "Must specify directory"
@@ -22,13 +24,13 @@ let getSourceDirectories ~includeDev base config =
2224
if typ = "dev" then []
2325
else
2426
match item |> Json.get "subdirs" with
25-
| None | Some Json.False -> [current /+ dir]
27+
| None | Some Json.False -> [current ++ dir]
2628
| Some Json.True ->
27-
Files.collectDirs (base /+ current /+ dir)
29+
Files.collectDirs (base ++ current ++ dir)
2830
(* |> ifDebug(true, "Subdirs", String.concat(" - ")) *)
2931
|> List.filter (fun name -> name <> Filename.current_dir_name)
3032
|> List.map (Files.relpath base)
31-
| Some item -> (current /+ dir) :: handleItem (current /+ dir) item)
33+
| Some item -> (current ++ dir) :: handleItem (current ++ dir) item)
3234
| _ -> failwith "Invalid subdirs entry"
3335
in
3436
match config |> Json.get "sources" with
@@ -104,11 +106,11 @@ let collectFiles directory =
104106
compileds
105107
|> List.map (fun path ->
106108
let modName = getName path in
107-
let compiled = directory /+ path in
109+
let compiled = directory ++ path in
108110
let source =
109111
Utils.find
110112
(fun name ->
111-
if getName name = modName then Some (directory /+ name) else None)
113+
if getName name = modName then Some (directory ++ name) else None)
112114
sources
113115
in
114116
(modName, SharedTypes.Impl (compiled, source)))
@@ -117,7 +119,7 @@ let collectFiles directory =
117119
let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
118120
let files =
119121
sourceDirectories
120-
|> List.map (Files.fileConcat root)
122+
|> List.map (Filename.concat root)
121123
|> ifDebug debug "Source directories" (String.concat " - ")
122124
|> List.map (fun name -> Files.collect name isSourceFile)
123125
|> List.concat |> Utils.dedup
@@ -127,8 +129,8 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
127129
|> Utils.filterMap(path => {
128130
let rel = Files.relpath(root, path);
129131
ifOneExists([
130-
compiledBase /+ cmtName(~namespace, rel),
131-
compiledBase /+ cmiName(~namespace, rel),
132+
compiledBase ++ cmtName(~namespace, rel),
133+
compiledBase ++ cmiName(~namespace, rel),
132134
]) |?>> cm => (cm, path)
133135
})
134136
|> ifDebug(debug, "With compiled base", (items) => String.concat("\n", List.map(((a, b)) => a ++ " : " ++ b, items)))
@@ -161,8 +163,8 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
161163
let base = compiledBaseName ~namespace (Files.relpath root path) in
162164
match intf with
163165
| Some intf ->
164-
let cmti = (compiledBase /+ base) ^ ".cmti" in
165-
let cmt = (compiledBase /+ base) ^ ".cmt" in
166+
let cmti = (compiledBase ++ base) ^ ".cmti" in
167+
let cmt = (compiledBase ++ base) ^ ".cmt" in
166168
if Files.exists cmti then
167169
if Files.exists cmt then
168170
(* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *)
@@ -171,15 +173,15 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
171173
else (
172174
(* Log.log("Just intf " ++ cmti) *)
173175
Log.log
174-
("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase /+ base)
176+
("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase ++ base)
175177
);
176178
None)
177179
| None ->
178-
let cmt = (compiledBase /+ base) ^ ".cmt" in
180+
let cmt = (compiledBase ++ base) ^ ".cmt" in
179181
if Files.exists cmt then Some (mname, Impl (cmt, Some path))
180182
else (
181183
Log.log
182-
("Bad source file (no cmt/cmi) " ^ (compiledBase /+ base));
184+
("Bad source file (no cmt/cmi) " ^ (compiledBase ++ base));
183185
None))
184186
else (
185187
Log.log ("Bad source file (extension) " ^ path);
@@ -191,7 +193,7 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
191193
(fun mname intf res ->
192194
let base = compiledBaseName ~namespace (Files.relpath root intf) in
193195
Log.log ("Extra intf " ^ intf);
194-
let cmti = (compiledBase /+ base) ^ ".cmti" in
196+
let cmti = (compiledBase ++ base) ^ ".cmti" in
195197
if Files.exists cmti then
196198
(mname, SharedTypes.Intf (cmti, intf)) :: res
197199
else res)
@@ -205,7 +207,7 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
205207
| None -> result
206208
| Some namespace ->
207209
let mname = nameSpaceToName namespace in
208-
let cmt = (compiledBase /+ namespace) ^ ".cmt" in
210+
let cmt = (compiledBase ++ namespace) ^ ".cmt" in
209211
Log.log ("adding namespace " ^ namespace ^ " : " ^ mname ^ " : " ^ cmt);
210212
(mname, Impl (cmt, None)) :: result
211213

@@ -234,7 +236,7 @@ let findDependencyFiles ~debug base config =
234236
let result =
235237
ModuleResolution.resolveNodeModulePath ~startPath:base name
236238
|?> fun loc ->
237-
let innerPath = loc /+ "bsconfig.json" in
239+
let innerPath = loc ++ "bsconfig.json" in
238240
Log.log ("Dep loc " ^ innerPath);
239241
match Files.readFile innerPath with
240242
| Some text -> (
@@ -248,7 +250,7 @@ let findDependencyFiles ~debug base config =
248250
| Some compiledBase ->
249251
if debug then Log.log ("Compiled base: " ^ compiledBase);
250252
let compiledDirectories =
251-
directories |> List.map (Files.fileConcat compiledBase)
253+
directories |> List.map (Filename.concat compiledBase)
252254
in
253255
let compiledDirectories =
254256
match namespace with

analysis/src/Infix.ml

-2
Original file line numberDiff line numberDiff line change
@@ -26,5 +26,3 @@ let logIfAbsent message x =
2626
Log.log message;
2727
None
2828
| _ -> x
29-
30-
let ( /+ ) = Files.fileConcat

analysis/src/ModuleResolution.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
1-
open Infix
2-
31
let rec resolveNodeModulePath ~startPath name =
4-
let path = startPath /+ "node_modules" /+ name in
2+
let path = Filename.concat (Filename.concat startPath "node_modules") name in
53
if Files.exists path then Some path
64
else if startPath = "/" then None
75
else resolveNodeModulePath ~startPath:(Filename.dirname startPath) name

analysis/src/Packages.ml

+5-3
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
open Infix
22

3+
let ( ++ ) = Filename.concat
4+
35
(* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *)
46
let makePathsForModule (localModules : (string * SharedTypes.paths) list)
57
(dependencyModules : (string * SharedTypes.paths) list) =
@@ -13,7 +15,7 @@ let makePathsForModule (localModules : (string * SharedTypes.paths) list)
1315
pathsForModule
1416

1517
let newBsPackage rootPath =
16-
let path = rootPath /+ "bsconfig.json" in
18+
let path = rootPath ++ "bsconfig.json" in
1719
match Files.readFile path with
1820
| None -> Error ("Unable to read " ^ path)
1921
| Some raw -> (
@@ -63,7 +65,7 @@ let newBsPackage rootPath =
6365
match namespace with
6466
| None -> []
6567
| Some namespace ->
66-
let cmt = (compiledBase /+ namespace) ^ ".cmt" in
68+
let cmt = (compiledBase ++ namespace) ^ ".cmt" in
6769
Log.log ("############ Namespaced as " ^ namespace ^ " at " ^ cmt);
6870
Hashtbl.add pathsForModule namespace (Impl (cmt, None));
6971
[FindFiles.nameSpaceToName namespace]
@@ -106,7 +108,7 @@ let findRoot ~uri packagesByRoot =
106108
let rec loop path =
107109
if path = "/" then None
108110
else if Hashtbl.mem packagesByRoot path then Some (`Root path)
109-
else if Files.exists (path /+ "bsconfig.json") then Some (`Bs path)
111+
else if Files.exists (path ++ "bsconfig.json") then Some (`Bs path)
110112
else
111113
let parent = Filename.dirname path in
112114
if parent = path then (* reached root *) None else loop parent

analysis/src/Uri2.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ end = struct
2929
let fromPath path = {path; uri = pathToUri path}
3030

3131
let fromLocalPath localPath =
32-
let path = Files.maybeConcat (Unix.getcwd ()) localPath in
32+
let path = Filename.concat (Unix.getcwd ()) localPath in
3333
fromPath path
3434

3535
let isInterface {path} = Filename.check_suffix path "i"

0 commit comments

Comments
 (0)