Soilihi BEN SOILIHI BOINA pushed to branch wop-server at Stefan / Typer

Commits: ad338dec by Soilih at 2022-07-31T13:49:01-04:00 tests for the server

- - - - -

1 changed file:

- src/lsp_server_test.ml

Changes:

===================================== src/lsp_server_test.ml ===================================== @@ -1,4 +1,17 @@ (* +********************************************************************* +********************************************************************* +********************************************************************* +********************************************************************* +************************* TEST THE SERVER *************************** +********************************************************************* +********************************************************************* +********************************************************************* +********************************************************************* +*) + + +(** * * * HOVER @@ -7,8 +20,8 @@ **)

let comp (a:string) (b:string) : string = - if (String.equal a b) then "/*******-----:-):-):-):-):-):-):-)__________SUCCESS_______:-):-):-):-):-):-):-)-----*******/\n\n\n" - else "/*******-----:-(:-(:-(:-(:-(:-(:-(____FAILED___:-(:-(:-(:-(:-(:-(:-(-----*******/\n\n\n" + if (String.equal a b) then "*******-------__________SUCCESS__________-------*******\n\n\n" + else "-------*******__________FAILED__________*******-------\n\n\n"

let hoverTest (ctx:Debruijn.lexp_context) (name:string) (content:string) (position: int * int) (expected:string) = let (_, ast, _) = Typer_lsp_server.compile_string content in @@ -16,11 +29,16 @@ let (list_list, _) = Option.get ast in let (l,c) = position in let pos = Typer_lsp_server.pos_of_tuple position in

-let (lctx,vx) = Typer_lsp_server.lexp_search ctx list_list pos in -let ((lvn,_),lexp,ltyp) = vx in +(* +let (lctx, vx) = Typer_lsp_server.lexp_search ctx list_list pos in +let ((lvn, _), lexp, ltyp) = vx in let (l_ctx_r,_,_,_,_,_) as ret = Typer_lsp_server.browse_lexp lctx lexp pos [] in let ret' = (l_ctx_r, None, ltyp, (Expression l_ctx_r : Typer_lsp_server.completion_type), lvn,[]) in let (_,_,l_type,_,_,_) = Typer_lsp_server.browse_list_lexp [ret;ret'] pos in +*) + +let lexp = Typer_lsp_server.trans_list_in_list_to_let list_list in +let (_, _, l_type, _, _, _) = Typer_lsp_server.browse_lexp ctx lexp pos [] in

let excpect = "excpected : " ^ expected ^ "\n" in let output = "output : " ^ (Lexp.lexp_string_for_lsp l_type) ^ "\n\n" in @@ -45,118 +63,125 @@ let test_hover_rapide () = hoverTest ctx name "lst = cons 1 nil" (1,8) ""

let test_hover () = -let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in -let name = "/home/soilih/Bureau/test/test.txt" in -sep name "INT"; -hoverTest ctx name "e = 12 ;" (1,1) "##Int"; -hoverTest ctx name "e = 12 ;" (1,5) "##Int"; -sep name "STRING"; -hoverTest ctx name "s = "hejej" ;" (1,1) "##String"; -hoverTest ctx name "s = "hejej" ;" (1,8) "##String"; -sep name "FLOAT"; -hoverTest ctx name "f = 12.3 ;" (1,1) "##Float"; -hoverTest ctx name "f = 12.3 ;" (1,6) "##Float"; -sep name "LAMBDA"; -hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,1) "(x : ##Int) -> Int"; -hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,8) "##Int"; -hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,13) "##Int"; -hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,23) ""; -hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,19) "(Int -> (Int -> Int))"; -hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,21) "##Int"; -hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,20) "##Int"; -hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,24) "##Int"; -hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,24) "##Int"; -hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,26) "##Int"; -sep name "FUNCTION(LAMBDA)"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,1) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,10) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,12) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,14) "τ"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,18) "(Int -> (Int -> Int))"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,21) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ;" (1,23) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,1) "(x : ##Int) -> (y : ##Int) -> (z : ##Int) -> Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,10) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,12) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,14) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,18) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,20) "(Int -> (Int -> Int))"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,22) "##Int"; -hoverTest ctx name "multiply x y z = x + y + z ;" (1,26) "##Int"; -sep name "CALL"; -hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,1) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,7) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; -hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,13) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,15) "##Int"; -hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,19) "##String"; -sep name "BUILTIN"; -hoverTest ctx name "foo = ##Int ;" (1,1) "##Type"; -hoverTest ctx name "foo = ##Int ;" (1,9) "##Type"; -sep name "SUSP"; -hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; -hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,6) "(##Type_ ##TypeLevel.z)"; -hoverTest ctx name "foo = ##String ; \n\n\nv = foo ;" (4,1) "(##Type_ (##TypeLevel.succ ##TypeLevel.z))"; -hoverTest ctx name "foo = ##Type ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; -sep name "LIST"; -hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,1) "(List ##TypeLevel.z ##Int)"; -hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,8) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (a -> ((List ℓ a) -> (List ℓ a)))"; -hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,12) "##Int"; -hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,27) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (List ℓ a)"; -sep name "TUPLE"; -hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ; \n\n\ntup = (1,2,"str",lst) ;" (4,1) "typecons (Tuple) (cons ##Int ##Int ##String (List ##TypeLevel.z ##Int))"; -hoverTest ctx name "tup = (1,2,"str",false) ;" (1,8) "##Int"; -hoverTest ctx name "tup = (1,2,"str",false) ;" (1,10) "##Int"; -hoverTest ctx name "tup = (1,2,"str",false) ;" (1,15) "##String"; -hoverTest ctx name "tup = (1,2,"str",false) ;" (1,21) "Bool"; -sep name "ARROW"; -hoverTest ctx name "type Floo = bar Int Int ;" (1,1) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,17) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,29) ""; -hoverTest ctx name "v = Int -> Int ;" (1,1) ""; -sep name "INDUCTIVE"; -hoverTest ctx name "type Floo = bar Int Int ;" (1,7) ""; -hoverTest ctx name "type Floo = bar Int Int ;" (1,18) ""; -hoverTest ctx name "type Floo = bar Int Int ;" (1,22) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,1) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,19) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,26) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,1) ""; -hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,10) ""; -hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,1) ""; -hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,10) ""; -hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,18) ""; -hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,24) ""; -hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,32) ""; -sep name "METAVAR"; -hoverTest ctx name "x : ?t = 3 ;" (1,1) ""; -hoverTest ctx name "x : ?t = 3 ;" (1,6) ""; -hoverTest ctx name "f x = _+_ ?y x ;" (1,1) ""; -hoverTest ctx name "f x = _+_ ?y x ;" (1,3) ""; -hoverTest ctx name "f x = _+_ ?y x ;" (1,12) ""; -hoverTest ctx name "f x = _+_ ?y x ;" (1,14) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,1) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,6) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,10) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,1) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,11) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,15) ""; -hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,24) ""; -sep name "LET"; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,1) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,10) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,18) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,26) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,35) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,37) ""; -hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,41) ""; -sep name "CASE"; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,1) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,5) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,14) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (3,4) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (3,13) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (5,4) ""; -hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (5,14) "" + let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in + let name = "/home/soilih/Bureau/test/test.txt" in + sep name "INT"; + hoverTest ctx name "e = 12 ;" (1,1) "Int"; + hoverTest ctx name "e = 12 ;" (1,5) "Int"; + sep name "STRING"; + hoverTest ctx name "s = "hejej" ;" (1,1) "String"; + hoverTest ctx name "s = "hejej" ;" (1,8) "String"; + sep name "FLOAT"; + hoverTest ctx name "f = 12.3 ;" (1,1) "Float"; + hoverTest ctx name "f = 12.3 ;" (1,6) "Float"; + sep name "LAMBDA"; + hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,1) "(x : ##Int) -> Int"; + hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,8) "Int"; + hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,13) "Int"; + hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,23) ""; + hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,19) "(Int -> (Int -> Int))"; + hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,21) "Int"; + hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,20) "Int"; + hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,24) "Int"; + hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,24) "Int"; + hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,26) "Int"; + sep name "FUNCTION(LAMBDA)"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,1) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,10) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,12) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,14) "τ"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,18) "(Int -> (Int -> Int))"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,21) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ;" (1,23) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,1) "(x : ##Int) -> (y : ##Int) -> (z : ##Int) -> Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,10) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,12) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,14) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,18) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,20) "(Int -> (Int -> Int))"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,22) "Int"; + hoverTest ctx name "multiply x y z = x + y + z ;" (1,26) "Int"; + sep name "CALL"; + hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,1) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,7) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; + hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,13) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,15) "Int"; + hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,19) "String"; + sep name "BUILTIN"; + hoverTest ctx name "foo = ##Int ;" (1,1) "Type"; + hoverTest ctx name "foo = ##Int ;" (1,9) "Type"; + sep name "SUSP"; + hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; + hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,6) "(##Type_ ##TypeLevel.z)"; + hoverTest ctx name "foo = ##String ; \n\n\nv = foo ;" (4,1) "(##Type_ (##TypeLevel.succ ##TypeLevel.z))"; + hoverTest ctx name "foo = ##Type ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; + sep name "LIST"; + hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,1) "(List ##Int)"; + hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,8) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (a -> ((List ℓ a) -> (List ℓ a)))"; + hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,12) "Int"; + hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,27) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (List ℓ a)"; + sep name "TUPLE"; + hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ; \n\n\ntup = (1,2,"str",lst) ;" (4,1) "typecons (Tuple) (cons ##Int ##Int ##String (List ##TypeLevel.z ##Int))"; + hoverTest ctx name "tup = (1,2,"str",false) ;" (1,8) "Int"; + hoverTest ctx name "tup = (1,2,"str",false) ;" (1,10) "Int"; + hoverTest ctx name "tup = (1,2,"str",false) ;" (1,15) "String"; + hoverTest ctx name "tup = (1,2,"str",false) ;" (1,21) "Bool"; + sep name "ARROW"; + hoverTest ctx name "type Floo = bar Int Int ;" (1,1) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,17) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,29) ""; + hoverTest ctx name "v = Int -> Int ;" (1,1) ""; + sep name "INDUCTIVE"; + hoverTest ctx name "type Floo = bar Int Int ;" (1,7) ""; + hoverTest ctx name "type Floo = bar Int Int ;" (1,18) ""; + hoverTest ctx name "type Floo = bar Int Int ;" (1,22) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,1) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,19) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,26) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,1) ""; + hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,10) ""; + hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,1) ""; + hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,10) ""; + hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,18) ""; + hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,24) ""; + hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,32) ""; + sep name "METAVAR"; + hoverTest ctx name "x : ?t = 3 ;" (1,1) "τ"; + hoverTest ctx name "x : ?t = 3 ;" (1,6) "τ"; + hoverTest ctx name "f x = _+_ ?y x ;" (1,1) "(y : Int) => (x : ##Int) -> Int"; + hoverTest ctx name "f x = _+_ ?y x ;" (1,3) "Int"; + hoverTest ctx name "f x = _+_ ?y x ;" (1,12) "Int"; + hoverTest ctx name "f x = _+_ ?y x ;" (1,14) "Int"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,1) "Int"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,6) "Int"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,10) "Int"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,1) "Int"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,11) "τ"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,15) "τ"; + hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,25) "Int"; + sep name "LET"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,1) "Int"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,11) "Int"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,19) "Int"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,31) "Int"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,36) "Int"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,38) "(Int -> (Int -> Int))"; + hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,44) "Int"; + sep name "CASE"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (2,1) "((List Int) -> (Option Int))"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (2,7) "List Int"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (2,18) "List Int"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (3,11) "Int"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (3,33) "Int"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (4,11) "Int"; + hoverTest ctx name "last : List Int -> Option Int ;\nlast lst = case lst\n | cons just_one nil => some just_one\n | cons first list_tl => last list_tl;" + (4,18) "List Int"

(* @@ -193,7 +218,7 @@ let afficher_lst code filename = ) x ) list_list

-(* +(** * * * BREADCRUMBS @@ -218,4 +243,160 @@ let testerBread cursor str =

let bread_test = afficher_lst "/home/soilih/Bureau/exemple.typer" "/home/soilih/Bureau/test/highlight.txt"; - testerBread (2,2) "multiply _x = \nlet lst = cons 2 nil in\nlst" \ No newline at end of file + testerBread (2,2) "multiply _x = \nlet lst = cons 2 nil in\nlst" + +(** +* +* +* GoTo Definition +* +* +**) + +let defTest (ctx:Debruijn.lexp_context) (name:string) (content:string) (position: int * int) = + let (_, ast, _) = Typer_lsp_server.compile_string content in + let (list_list, _) = Option.get ast in + let (l, c) = position in + let pos = Typer_lsp_server.pos_of_tuple position in + + let lexp = Typer_lsp_server.trans_list_in_list_to_let list_list in + let ret = Typer_lsp_server.browse_lexp ctx lexp pos [] in + let loc = Typer_lsp_server.find_def_location ret in + + let output = "output-:- " ^ "line: " ^ (string_of_int (loc.start_line)) + ^ "column: " ^ (string_of_int (loc.start_column)) ^ "\n\n" in + let input = "input : " ^ content ^ "\n" in + let pos = "position : line " ^ (string_of_int l) ^ " character " ^ (string_of_int c) ^ "\n" in + let sep = "################################################\n" in + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in + output_string oc (sep ^ input ^ pos ^ output ^ sep ); + close_out oc + + +let test_definition () = + let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in + let name = "/home/soilih/Bureau/test/test.txt" in + defTest ctx name "multiply : ? ;\nmultiply x y = _*_ x y ;\nsix = multiply 2 3" (2,20); + defTest ctx name "multiply : ? ;\nmultiply x y = _*_ x y ;\nsix = multiply 2 3" (3,10) + +(* List of separators that delimit a word *) +let sep_list = [';';',';'(';')';' ';'{';'}';'.'] + +(** +* +* +* Completion +* +* +**) + +let completionTest (ctx:Debruijn.lexp_context) (content:string) (position: int * int) = + let (_, ast, _) = Typer_lsp_server.compile_string content in + let (list_list, _) = Option.get ast in + let (l, c) = position in + let pos = Typer_lsp_server.pos_of_tuple position in + let lexp = Typer_lsp_server.trans_list_in_list_to_let list_list in + ( + match Typer_lsp_server.browse_lexp ctx lexp pos [] with + | (_, _, _, Expression l_ctx, _, _) + -> let my_str = Typer_lsp_server.split_string_line content (l + 1) in + let word = Typer_lsp_server.use_search_word my_str sep_list c "" in + let range = Typer_lsp_server.lsp_range_of_a_tuple + (pos.start_line,(pos.end_column - String.length word)) + (pos.end_line, pos.end_column) + in + let filtred_list = Typer_lsp_server.filter_lctx l_ctx [] in + let comp_list = Typer_lsp_server.ctx_to_ci_list filtred_list range in + let comp_list_ret = Typer_lsp_server.complete_oth word comp_list in + List.map (fun (x : Lsp.Types.CompletionItem.t) -> + let detail = Option.get x.detail in + x.label ^ " (" ^ detail ^ ")") + comp_list_ret + + | (lctx, _, _, FieldName lxp, _,_) + -> (let ret = Opslexp.lexp_whnf lxp lctx in + match Lexp.lexp_lexp' ret with + | Inductive (_, (_,label), fargs, constructors) + when Util.SMap.cardinal constructors = 1 + -> let my_str = Typer_lsp_server.split_string_line content (l + 1) in + let word = Typer_lsp_server.use_search_word my_str sep_list c "" in + let range = Typer_lsp_server.lsp_range_of_a_tuple + (pos.start_line,(pos.end_column - String.length word)) + (pos.end_line, pos.end_column) + in + let (_, fieldtypes) = List.hd (Util.SMap.bindings constructors) in + let comp_list = + List.map ( fun (x : Lexp.arg_kind * Util.vname * Lexp.lexp) -> + let (_,(_,s),t) = x in + let str = Option.get s in + let textEdit = Lsp.Types.TextEdit.create ~range:range ~newText:(str) in + let kind = Lsp.Types.CompletionItemKind.Function in + let ci = Lsp.Types.CompletionItem.create + ~label:str ~kind:kind + ~textEdit:textEdit ~detail:(Lexp.lexp_string_for_lsp t) () + in + ci + ) fieldtypes + in + List.map (fun (x : Lsp.Types.CompletionItem.t) -> + let detail = Option.get x.detail in + x.label ^ " (" ^ detail ^ ")") + comp_list + | _ -> failwith "Our Lexp is not an Inductive Type!!!" + ) + ) + +let test_completion () = + let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in + let name = "/home/soilih/Bureau/test/completion.txt" in + let ret = completionTest ctx "multiply : ? ;\nmultiply x y = _*_ x y ;\nn = m" (3,5) in + (*let ret' = completionTest ctx "multiply : ? ;\nmultiply x y = _*_ x y ;\nn = list.m" (3,10) in*) + let wr = List.fold_right (fun (s : string) r -> + r ^ s ^ "\n" + ) ret "" + in + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in + output_string oc wr; + close_out oc + +let highlightTest(ctx:Debruijn.lexp_context) (name:string) (content:string) (position: int * int) = + let (_, ast, _) = Typer_lsp_server.compile_string content in + let (list_list, _) = Option.get ast in + let pos = Typer_lsp_server.pos_of_tuple position in + let lexp = Typer_lsp_server.trans_list_in_list_to_let list_list in + let (lxp, vn, idx) = try Option.get (Typer_lsp_server.browse_defs lexp pos) + with _ + -> Log.log_error ~loc:(Lexp.lexp_location lexp) "No highlight found!"; + (Lexp.impossible, (Util.dummy_location, None), 0) + in + let ret = Typer_lsp_server.find_references lxp vn idx [vn] in + let ret' = List.fold_right (fun (vn: Util.vname) r -> + let (l, s) = vn in + let s' = Option.get s in + r ^ s' ^ " (l: " ^ ((string_of_int l.start_line)) + ^ "-" ^ ((string_of_int l.end_line)) + ^ " c: " ^ ((string_of_int l.start_column)) + ^ "-" ^ ((string_of_int l.end_column)) ^ ")" + ) ret "" + in + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in + output_string oc ret'; + close_out oc + +let test_highlight () = + let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in + let name = "/home/soilih/Bureau/test/highlight.txt" in + highlightTest ctx name "multiply : ? ;\nmultiply x y = _*_ x y ;\nsix = multiply 2 3 ;\ndix = multiply 2 5" (2,4) + + +(* +********************************************************************* +********************************************************************* +********************************************************************* +********************************************************************* +************************ END OF THE TESTS *************************** +********************************************************************* +********************************************************************* +********************************************************************* +********************************************************************* +*) \ No newline at end of file

View it on GitLab: https://gitlab.com/monnier/typer/-/commit/ad338dec5e71760c22feaf471e6a1f9d4c...