Skip to content

Commit 7617e7f

Browse files
committed
Fix issue where vscode would crash on invalid semantic token.
Fixes #409 On parser recovery from "module ", a dummy expression would be generated at position (0,-1) by parser recovery. And this would make it to the semantic token array with delta char "-1" which crashes vscode.
1 parent 194bd3a commit 7617e7f

File tree

1 file changed

+60
-48
lines changed

1 file changed

+60
-48
lines changed

analysis/src/SemanticTokens.ml

Lines changed: 60 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,6 @@ module Token = struct
2929
| Property (** {x:...} *)
3030
| JsxLowercase (** div in <div> *)
3131

32-
type tokenModifiers = NoModifier
33-
3432
let tokenTypeToString = function
3533
| Operator -> "0"
3634
| Variable -> "1"
@@ -51,9 +49,9 @@ module Token = struct
5149
| Property -> "Property"
5250
| JsxLowercase -> "JsxLowercase"
5351

54-
let tokenModifiersToString = function NoModifier -> "0"
52+
let tokenModifiersString = "0" (* None at the moment *)
5553

56-
type token = int * int * int * tokenType * tokenModifiers
54+
type token = int * int * int * tokenType
5755

5856
type emitter = {
5957
mutable tokens : token list;
@@ -64,24 +62,27 @@ module Token = struct
6462
let createEmitter () = {tokens = []; lastLine = 0; lastChar = 0}
6563

6664
let add ~line ~char ~length ~type_ e =
67-
let modifiers = NoModifier in
68-
e.tokens <- (line, char, length, type_, modifiers) :: e.tokens
65+
e.tokens <- (line, char, length, type_) :: e.tokens
6966

70-
let emitToken buf (line, char, length, type_, modifiers) e =
67+
let emitToken buf (line, char, length, type_) e =
7168
let deltaLine = line - e.lastLine in
7269
let deltaChar = if deltaLine = 0 then char - e.lastChar else char in
7370
e.lastLine <- line;
7471
e.lastChar <- char;
7572
if Buffer.length buf > 0 then Buffer.add_char buf ',';
76-
Buffer.add_string buf
77-
(string_of_int deltaLine ^ "," ^ string_of_int deltaChar ^ ","
78-
^ string_of_int length ^ "," ^ tokenTypeToString type_ ^ ","
79-
^ tokenModifiersToString modifiers)
73+
if
74+
deltaLine >= 0 && deltaChar >= 0 && length >= 0
75+
(* Defensive programming *)
76+
then
77+
Buffer.add_string buf
78+
(string_of_int deltaLine ^ "," ^ string_of_int deltaChar ^ ","
79+
^ string_of_int length ^ "," ^ tokenTypeToString type_ ^ ","
80+
^ tokenModifiersString)
8081

8182
let emit e =
8283
let sortedTokens =
8384
e.tokens
84-
|> List.sort (fun (l1, c1, _, _, _) (l2, c2, _, _, _) ->
85+
|> List.sort (fun (l1, c1, _, _) (l2, c2, _, _) ->
8586
if l1 = l2 then compare c1 c2 else compare l1 l2)
8687
in
8788
let buf = Buffer.create 1 in
@@ -166,8 +167,9 @@ let emitVariable ~id ~debug ~loc emitter =
166167
if debug then Printf.printf "Variable: %s %s\n" id (Loc.toString loc);
167168
emitter |> emitFromLoc ~loc ~type_:Variable
168169

169-
let emitJsxOpen ~lid ~debug ~loc emitter =
170-
emitter |> emitLongident ~pos:(Loc.start loc) ~lid ~jsx:true ~debug
170+
let emitJsxOpen ~lid ~debug ~(loc : Location.t) emitter =
171+
if not loc.loc_ghost then
172+
emitter |> emitLongident ~pos:(Loc.start loc) ~lid ~jsx:true ~debug
171173

172174
let emitJsxClose ~lid ~debug ~pos emitter =
173175
emitter |> emitLongident ~backwards:true ~pos ~lid ~jsx:true ~debug
@@ -176,20 +178,23 @@ let emitJsxTag ~debug ~name ~pos emitter =
176178
if debug then Printf.printf "JsxTag %s: %s\n" name (Pos.toString pos);
177179
emitter |> emitFromRange (pos, (fst pos, snd pos + 1)) ~type_:Token.JsxTag
178180

179-
let emitType ~lid ~debug ~loc emitter =
180-
emitter
181-
|> emitLongident ~lowerCaseToken:Token.Type ~pos:(Loc.start loc) ~lid ~debug
181+
let emitType ~lid ~debug ~(loc : Location.t) emitter =
182+
if not loc.loc_ghost then
183+
emitter
184+
|> emitLongident ~lowerCaseToken:Token.Type ~pos:(Loc.start loc) ~lid ~debug
182185

183186
let emitRecordLabel ~(label : Longident.t Location.loc) ~debug emitter =
184-
emitter
185-
|> emitLongident ~lowerCaseToken:Token.Property ~pos:(Loc.start label.loc)
186-
~posEnd:(Some (Loc.end_ label.loc))
187-
~lid:label.txt ~debug
187+
if not label.loc.loc_ghost then
188+
emitter
189+
|> emitLongident ~lowerCaseToken:Token.Property ~pos:(Loc.start label.loc)
190+
~posEnd:(Some (Loc.end_ label.loc))
191+
~lid:label.txt ~debug
188192

189193
let emitVariant ~(name : Longident.t Location.loc) ~debug emitter =
190-
emitter
191-
|> emitLongident ~lastToken:(Some Token.EnumMember) ~pos:(Loc.start name.loc)
192-
~lid:name.txt ~debug
194+
if not name.loc.loc_ghost then
195+
emitter
196+
|> emitLongident ~lastToken:(Some Token.EnumMember)
197+
~pos:(Loc.start name.loc) ~lid:name.txt ~debug
193198

194199
let command ~debug ~emitter ~path =
195200
let processTypeArg (coreType : Parsetree.core_type) =
@@ -235,10 +240,11 @@ let command ~debug ~emitter ~path =
235240
match e.pexp_desc with
236241
| Pexp_ident {txt = lid; loc} ->
237242
if lid <> Lident "not" then
238-
emitter
239-
|> emitLongident ~pos:(Loc.start loc)
240-
~posEnd:(Some (Loc.end_ loc))
241-
~lid ~debug;
243+
if not loc.loc_ghost then
244+
emitter
245+
|> emitLongident ~pos:(Loc.start loc)
246+
~posEnd:(Some (Loc.end_ loc))
247+
~lid ~debug;
242248
Ast_iterator.default_iterator.expr iterator e
243249
| Pexp_apply ({pexp_desc = Pexp_ident lident; pexp_loc}, args)
244250
when Res_parsetree_viewer.isJsxExpression e ->
@@ -320,50 +326,56 @@ let command ~debug ~emitter ~path =
320326
(me : Parsetree.module_expr) =
321327
match me.pmod_desc with
322328
| Pmod_ident {txt = lid; loc} ->
323-
emitter |> emitLongident ~pos:(Loc.start loc) ~lid ~debug;
329+
if not loc.loc_ghost then
330+
emitter |> emitLongident ~pos:(Loc.start loc) ~lid ~debug;
324331
Ast_iterator.default_iterator.module_expr iterator me
325332
| _ -> Ast_iterator.default_iterator.module_expr iterator me
326333
in
327334
let module_binding (iterator : Ast_iterator.iterator)
328335
(mb : Parsetree.module_binding) =
329-
emitter
330-
|> emitLongident
331-
~pos:(Loc.start mb.pmb_name.loc)
332-
~lid:(Longident.Lident mb.pmb_name.txt) ~debug;
336+
if not mb.pmb_name.loc.loc_ghost then
337+
emitter
338+
|> emitLongident
339+
~pos:(Loc.start mb.pmb_name.loc)
340+
~lid:(Longident.Lident mb.pmb_name.txt) ~debug;
333341
Ast_iterator.default_iterator.module_binding iterator mb
334342
in
335343
let module_declaration (iterator : Ast_iterator.iterator)
336344
(md : Parsetree.module_declaration) =
337-
emitter
338-
|> emitLongident
339-
~pos:(Loc.start md.pmd_name.loc)
340-
~lid:(Longident.Lident md.pmd_name.txt) ~debug;
345+
if not md.pmd_name.loc.loc_ghost then
346+
emitter
347+
|> emitLongident
348+
~pos:(Loc.start md.pmd_name.loc)
349+
~lid:(Longident.Lident md.pmd_name.txt) ~debug;
341350
Ast_iterator.default_iterator.module_declaration iterator md
342351
in
343352
let module_type (iterator : Ast_iterator.iterator)
344353
(mt : Parsetree.module_type) =
345354
match mt.pmty_desc with
346355
| Pmty_ident {txt = lid; loc} ->
347-
emitter
348-
|> emitLongident ~upperCaseToken:Token.Type ~pos:(Loc.start loc) ~lid
349-
~debug;
356+
if not loc.loc_ghost then
357+
emitter
358+
|> emitLongident ~upperCaseToken:Token.Type ~pos:(Loc.start loc) ~lid
359+
~debug;
350360
Ast_iterator.default_iterator.module_type iterator mt
351361
| _ -> Ast_iterator.default_iterator.module_type iterator mt
352362
in
353363
let module_type_declaration (iterator : Ast_iterator.iterator)
354364
(mtd : Parsetree.module_type_declaration) =
355-
emitter
356-
|> emitLongident ~upperCaseToken:Token.Type
357-
~pos:(Loc.start mtd.pmtd_name.loc)
358-
~lid:(Longident.Lident mtd.pmtd_name.txt) ~debug;
365+
if not mtd.pmtd_name.loc.loc_ghost then
366+
emitter
367+
|> emitLongident ~upperCaseToken:Token.Type
368+
~pos:(Loc.start mtd.pmtd_name.loc)
369+
~lid:(Longident.Lident mtd.pmtd_name.txt) ~debug;
359370
Ast_iterator.default_iterator.module_type_declaration iterator mtd
360371
in
361372
let open_description (iterator : Ast_iterator.iterator)
362373
(od : Parsetree.open_description) =
363-
emitter
364-
|> emitLongident
365-
~pos:(Loc.start od.popen_lid.loc)
366-
~lid:od.popen_lid.txt ~debug;
374+
if not od.popen_lid.loc.loc_ghost then
375+
emitter
376+
|> emitLongident
377+
~pos:(Loc.start od.popen_lid.loc)
378+
~lid:od.popen_lid.txt ~debug;
367379
Ast_iterator.default_iterator.open_description iterator od
368380
in
369381
let label_declaration (iterator : Ast_iterator.iterator)

0 commit comments

Comments
 (0)