Test more reference formats

OCamlPro · Oct 6, 2023 · e3ca83b · e3ca83b
1 parent 1d0c4d1
commit e3ca83b
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 423 deletions.
diff --git a/src/lsp/superbol_free_lib/common_args.ml b/src/lsp/superbol_free_lib/common_args.ml
@@ -49,13 +49,20 @@ let iter_comma_separated_spec ~showable ~option_name ~f spec =
                 (StringSet.elements unknowns))
 
 let get () =
-  let conf = ref "" in                                    (* Fixed by default *)
+  let conf = ref "" in
   let dialect = ref None in
   let strict = ref false in
   let format = ref Cobol_config.Auto in                   (* Fixed by default *)
   let formats = ["free"; "Free"; "FREE";
                  "fixed"; "Fixed"; "FIXED";
-                 "cobolx"; "Cobolx"; "CobolX"; "COBOLX"] in
+                 "cobol85"; "COBOL85";
+                 "variable"; "VARIABLE";
+                 "xopen"; "XOPEN"; "XOpen";
+                 "xcard"; "xCard"; "XCARD";
+                 "crt"; "CRT";
+                 "terminal"; "Terminal"; "TERMINAL";
+                 "cobolx"; "Cobolx"; "CobolX"; "COBOLX";
+                 "auto"; "AUTO"] in
   let libpath = ref ["."] in
   let recovery = ref true in
   let show = ref [`Pending] in                                     (* default *)
@@ -80,9 +87,15 @@ let get () =
 
     ["source-format"],
     Arg.Symbol (formats, fun f -> format := match String.uppercase_ascii f with
-        | "FIXED" -> Cobol_config.SF Cobol_config.SFFixed
+        | "FIXED" | "COBOL85" -> Cobol_config.SF Cobol_config.SFFixed
         | "FREE" -> SF SFFree
+        | "VARIABLE" -> SF SFVariable
+        | "XOPEN" -> SF SFXOpen
+        | "XCARD" -> SF SFxCard
+        | "CRT" -> SF SFCRT
+        | "TERMINAL" -> SF SFTrm
         | "COBOLX" -> SF SFCOBOLX
+        | "AUTO" -> Auto
         | _ ->
             Cobol_common.Diagnostics.Now.warn
               Fmt.stderr

diff --git a/test/output-tests/gnucobol.ml b/test/output-tests/gnucobol.ml
@@ -137,7 +137,40 @@ let setup_input ~filename contents =
 let delete_file ~filename =
   Ez_file.FileString.remove filename
 
-let free_format_regexp = Str.regexp {re|\(^-free\|[ \t]-free\b\)|re}
+let free_flag_regexp = Str.regexp {re|\(^-free\|[ \t]-free\b\)|re}
+let fixd_format_regexp = Str.regexp_string "-fformat=fixed"
+let free_format_regexp = Str.regexp_string "-fformat=free"
+let cb85_format_regexp = Str.regexp_string "-fformat=cobol85"
+let vrbl_format_regexp = Str.regexp_string "-fformat=variable"
+let xopn_format_regexp = Str.regexp_string "-fformat=xopen"
+let xcrd_format_regexp = Str.regexp_string "-fformat=xcard"
+let crt__format_regexp = Str.regexp_string "-fformat=crt"
+let term_format_regexp = Str.regexp_string "-fformat=terminal"
+let cblx_format_regexp = Str.regexp_string "-fformat=cobolx"
+let auto_format_regexp = Str.regexp_string "-fformat=auto"
+
+let guess_source_format ~filename ~command =   (* hackish detection of format *)
+  let filename_suffixp suffix =
+    EzString.ends_with ~suffix filename
+  and command_matchp regexp =
+    try ignore (Str.search_forward regexp command 0); true
+    with Not_found -> false
+  in
+  Option.value ~default:Cobol_config.(SF SFFixed) @@
+  List.find_map (fun (p, f) -> if Lazy.force p then Some f else None) [
+    lazy (filename_suffixp "free.cob"),       Cobol_config.(SF SFFree);
+    lazy (command_matchp free_flag_regexp),   Cobol_config.(SF SFFree);
+    lazy (command_matchp fixd_format_regexp), Cobol_config.(SF SFFixed);
+    lazy (command_matchp free_format_regexp), Cobol_config.(SF SFFree);
+    lazy (command_matchp cb85_format_regexp), Cobol_config.(SF SFFixed);
+    lazy (command_matchp vrbl_format_regexp), Cobol_config.(SF SFVariable);
+    lazy (command_matchp xopn_format_regexp), Cobol_config.(SF SFXOpen);
+    lazy (command_matchp xcrd_format_regexp), Cobol_config.(SF SFxCard);
+    lazy (command_matchp term_format_regexp), Cobol_config.(SF SFTrm);
+    lazy (command_matchp cblx_format_regexp), Cobol_config.(SF SFCOBOLX);
+    lazy (command_matchp auto_format_regexp), Cobol_config.Auto;
+  ]
+
 let do_check_parse (test_filename, contents, _, { check_loc;
                                                   check_command; _ }) =
   let filename = filename_for_loc test_filename check_loc in
@@ -150,13 +183,7 @@ let do_check_parse (test_filename, contents, _, { check_loc;
   let loc = Autofonce_m4.M4Printer.string_of_location check_loc in
   Pretty.error "Considering: %a... " pp_relloc loc;
   Pretty.out   "Considering: %a@\n" pp_relloc loc;
-  let source_format =                          (* hackish detection of format *)
-    if EzString.ends_with ~suffix:"free.cob" filename ||
-       try ignore (Str.search_forward free_format_regexp check_command 0); true
-       with Not_found -> false
-    then Cobol_config.(SF SFFree)
-    else Cobol_config.(SF SFFixed)
-  in
+  let source_format = guess_source_format ~filename ~command:check_command in
   let parse_simple input =
     input |>
     Cobol_preproc.preprocessor