diff --git a/src/lsp/cobol_ast/raw_data_sections_visitor.ml b/src/lsp/cobol_ast/raw_data_sections_visitor.ml index 7cf1c7241..e08ef10c1 100644 --- a/src/lsp/cobol_ast/raw_data_sections_visitor.ml +++ b/src/lsp/cobol_ast/raw_data_sections_visitor.ml @@ -18,7 +18,8 @@ open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) open Terms_visitor let todo x = Cobol_common.Visitor.todo __FILE__ x -let partial x = Cobol_common.Visitor.partial __FILE__ x +let partial modname line funcname = + Cobol_common.Visitor.partial __FILE__ modname line funcname (* --- *) @@ -85,7 +86,7 @@ struct end let todo x = todo __MODULE__ x - and partial x = partial __MODULE__ x + and partial line funcname = partial __MODULE__ line funcname let fold_data_level (v: _ #folder) = leaf v#fold_data_level diff --git a/src/lsp/cobol_common/visitor.ml b/src/lsp/cobol_common/visitor.ml index 3f335bbe0..0f285ce2e 100644 --- a/src/lsp/cobol_common/visitor.ml +++ b/src/lsp/cobol_common/visitor.ml @@ -57,6 +57,8 @@ module INFIX = struct end open INFIX +let in_testsuite = ref false + let report = (* to be kept until visitors are complete *) let module REPORTED = Hashtbl.Make (struct @@ -68,6 +70,9 @@ let report = (* to be kept until visitors are complete *) let reported_table = lazy (REPORTED.create 17) in fun k file_name module_name line_num func_name -> let tbl = Lazy.force reported_table in + let file_name = + if !in_testsuite then Filename.basename file_name else file_name in + let line_num = if !in_testsuite then 0 else line_num in if not (REPORTED.mem tbl (file_name, module_name, line_num, func_name)) then begin Pretty.error "@[<2>%s:%u:@ (%s.%s):@ %s@ visitor@ implementation@]@." diff --git a/test/lsp/lsp_formatting.ml b/test/lsp/lsp_formatting.ml index 334c300dd..5962cb99d 100644 --- a/test/lsp/lsp_formatting.ml +++ b/test/lsp/lsp_formatting.ml @@ -401,10 +401,10 @@ let%expect_test "formatting-request-whole-program" = end_with_postproc [%expect.output]; [%expect {| {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} - src/lsp/cobol_ast/raw_misc_sections_visitor.ml:66: + raw_misc_sections_visitor.ml:0: (Cobol_ast__Raw_misc_sections_visitor.fold_select_clause): missing visitor implementation - src/lsp/cobol_ast/raw_data_sections_visitor.ml:280: + raw_data_sections_visitor.ml:0: (Cobol_ast__Raw_data_sections_visitor.fold_file_section): missing visitor implementation {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} diff --git a/test/lsp/lsp_references.ml b/test/lsp/lsp_references.ml index ab58c9767..d8cb3d0b0 100644 --- a/test/lsp/lsp_references.ml +++ b/test/lsp/lsp_references.ml @@ -15,6 +15,9 @@ open EzCompat (* StringMap *) open Lsp.Types open Lsp_testing +(* Used to remove full-path and lines in the test files *) +let () = + Cobol_common.Visitor.in_testsuite := true let print_references ~projdir server (doc, positions) : unit = let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in @@ -57,7 +60,7 @@ let%expect_test "simple-references-requests" = end_with_postproc [%expect.output]; [%expect {| {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} - src/lsp/cobol_ast/raw_data_sections_visitor.ml:231: + raw_data_sections_visitor.ml:0: (Cobol_ast__Raw_data_sections_visitor.fold_data_clause): partial visitor implementation {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} diff --git a/test/output-tests/gnucobol.ml b/test/output-tests/gnucobol.ml index be8234551..fe9ccfd1c 100644 --- a/test/output-tests/gnucobol.ml +++ b/test/output-tests/gnucobol.ml @@ -40,12 +40,28 @@ let target = (** [pp_relloc ppf filename] prints [filename] relative to [srcdir] if the latter is a directory (prefix) of [filename]. Otherwise, prints [filename] as a whole. *) + (* let pp_relloc = let srcdir_prefix = srcdir ^ Ez_file.FileOS.dir_separator_string in fun ppf s -> - match EzString.chop_prefix ~prefix:srcdir_prefix s with - | Some s -> Fmt.string ppf s - | None -> Fmt.string ppf s + let s = + match EzString.chop_prefix ~prefix:srcdir_prefix s with + | Some s -> s + | None -> s + in + Fmt.string ppf s +*) + +let pp_relloc fmt s = + let path = EzString.split s '/' in + let rec iter path = + match path with + | [] -> s + | "import" :: "gnucobol" :: _ -> String.concat "/" path + | _ :: path -> iter path + in + let s = iter path in + Fmt.string fmt s let make_n_enter_rundir () = Superbol_testutils.Tempdir.make_n_enter "superbol-gnucobol-tests" diff --git a/test/output-tests/preproc.ml b/test/output-tests/preproc.ml index 24cec6c1a..a7246e34a 100644 --- a/test/output-tests/preproc.ml +++ b/test/output-tests/preproc.ml @@ -16,8 +16,22 @@ open Ez_file open FileString.OP open Cobol_preproc +let find_dir anchor = + let curdir = Sys.getcwd () in + let rec iter path = + if Sys.file_exists (path // anchor) then + path + else + let path' = Filename.dirname path in + if path = path' then + Printf.kprintf failwith "Anchor %S not found from %s" anchor curdir; + iter path' + in + iter curdir + let deep_iter = FileString.(make_select iter_dir) ~deep:true -let srcdir = try Unix.getenv "DUNE_SOURCEROOT" with Not_found -> "." +let srcdir = try Unix.getenv "DUNE_SOURCEROOT" with Not_found -> + find_dir "test" let testsuites = "test/testsuite" let ibm_testsuite = testsuites // "ibm/ibmmainframes.com" let ibm_root = srcdir // ibm_testsuite