Merge pull request #28 from lefessan/z-2023-09-28-rebase-Considering

Always print tests output relative to import/gnucobol/

Author: lefessan

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

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@]@."

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"}

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"}

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 ppf 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 ppf s
 
 let make_n_enter_rundir () =
   Superbol_testutils.Tempdir.make_n_enter "superbol-gnucobol-tests"

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