From 490908bfeea71ef7ce326f0dc35ba2b9c563a39d Mon Sep 17 00:00:00 2001 From: sehoon Date: Tue, 14 Jun 2022 01:26:42 +0900 Subject: [PATCH 1/4] fix crash on polymorphic variant type --- src/res_core.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/res_core.ml b/src/res_core.ml index 630aad2c..c7e17864 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -4973,7 +4973,7 @@ and parsePolymorphicVariantType ~attrs p = then begin Parser.next p; let rec loop p = match p.Parser.token with - | Rbracket -> [] + | Eof | Rbracket -> [] | _ -> let (ident, _loc) = parseHashIdent ~startPos:p.startPos p in ident :: loop p From e4ea5df20f0fa908d1e45c16b5f5dc1d5af29707 Mon Sep 17 00:00:00 2001 From: sehoon Date: Tue, 14 Jun 2022 14:59:14 +0900 Subject: [PATCH 2/4] add testcase --- .../expected/polymorphicVariantType.res.txt | 9 +++++++++ tests/parsing/infiniteLoops/polymorphicVariantType.res | 1 + 2 files changed, 10 insertions(+) create mode 100644 tests/parsing/infiniteLoops/expected/polymorphicVariantType.res.txt create mode 100644 tests/parsing/infiniteLoops/polymorphicVariantType.res diff --git a/tests/parsing/infiniteLoops/expected/polymorphicVariantType.res.txt b/tests/parsing/infiniteLoops/expected/polymorphicVariantType.res.txt new file mode 100644 index 00000000..e9295283 --- /dev/null +++ b/tests/parsing/infiniteLoops/expected/polymorphicVariantType.res.txt @@ -0,0 +1,9 @@ + + Syntax error! + tests/parsing/infiniteLoops/polymorphicVariantType.res:1:14 + + 1 │ type x = [ + + Did you forget a `]` here? + +type nonrec x = [< y] \ No newline at end of file diff --git a/tests/parsing/infiniteLoops/polymorphicVariantType.res b/tests/parsing/infiniteLoops/polymorphicVariantType.res new file mode 100644 index 00000000..fbc32459 --- /dev/null +++ b/tests/parsing/infiniteLoops/polymorphicVariantType.res @@ -0,0 +1 @@ +type x = [ \ No newline at end of file From cf8ba1116b684fe51a05ada5e9f72c1b8c3e3321 Mon Sep 17 00:00:00 2001 From: sehoon Date: Wed, 15 Jun 2022 02:42:48 +0900 Subject: [PATCH 3/4] fix pattern matching priority in parsePolymorphicVariantType --- src/res_core.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index c7e17864..1b947607 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -4973,10 +4973,10 @@ and parsePolymorphicVariantType ~attrs p = then begin Parser.next p; let rec loop p = match p.Parser.token with - | Eof | Rbracket -> [] - | _ -> + | Hash -> let (ident, _loc) = parseHashIdent ~startPos:p.startPos p in ident :: loop p + | _ -> [] in loop p end From e4c063ad77525e45c584fead95296b4f8d313eb9 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 14 Jun 2022 23:57:34 +0200 Subject: [PATCH 4/4] Put parseTagName at the toplevel. --- src/res_core.ml | 30 ++++++++++++++++-------------- src/res_grammar.ml | 4 ++++ 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 1b947607..7d891f5d 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -4968,19 +4968,7 @@ and parsePolymorphicVariantType ~attrs p = Parser.optional p Bar |> ignore; let rowField = parseTagSpecFull p in let rowFields = parseTagSpecFulls p in - let tagNames = - if p.token == GreaterThan - then begin - Parser.next p; - let rec loop p = match p.Parser.token with - | Hash -> - let (ident, _loc) = parseHashIdent ~startPos:p.startPos p in - ident :: loop p - | _ -> [] - in - loop p - end - else [] in + let tagNames = parseTagNames p in let variant = let loc = mkLoc startPos p.prevEndPos in Ast_helper.Typ.variant ~attrs ~loc (rowField :: rowFields) Closed (Some tagNames) in @@ -4995,6 +4983,20 @@ and parsePolymorphicVariantType ~attrs p = Parser.expect Rbracket p; variant +and parseTagName p = + match p.Parser.token with + | Hash -> + let (ident, _loc) = parseHashIdent ~startPos:p.startPos p in + Some ident + | _ -> None + +and parseTagNames p = + if p.Parser.token == GreaterThan then + (Parser.next p; + parseRegion p ~grammar:Grammar.TagNames ~f:parseTagName) + else + [] + and parseTagSpecFulls p = match p.Parser.token with | Rbracket -> @@ -6449,4 +6451,4 @@ let parseSpecification p : Parsetree.signature = (* module structure on the file level *) let parseImplementation p : Parsetree.structure = - parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion + parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion \ No newline at end of file diff --git a/src/res_grammar.ml b/src/res_grammar.ml index ac649a1e..061c17a4 100644 --- a/src/res_grammar.ml +++ b/src/res_grammar.ml @@ -58,6 +58,7 @@ type t = | JsFfiImport | Pattern | AttributePayload + | TagNames let toString = function | OpenDescription -> "an open description" @@ -118,6 +119,7 @@ let toString = function | Pattern -> "pattern" | ExprFor -> "a for expression" | AttributePayload -> "an attribute payload" + | TagNames -> "tag names" let isSignatureItemStart = function | Token.At @@ -336,6 +338,7 @@ let isListElement grammar token = | JsxAttribute -> isJsxAttributeStart token | JsFfiImport -> isJsFfiImportStart token | AttributePayload -> token = Lparen + | TagNames -> token = Hash | _ -> false let isListTerminator grammar token = @@ -361,6 +364,7 @@ let isListTerminator grammar token = | PackageConstraint, token when token <> And -> true | ConstructorDeclaration, token when token <> Bar -> true | AttributePayload, Rparen -> true + | TagNames, Rbracket -> true | _ -> false