Import more tests

.autofonce

@@ -0,0 +1,45 @@
+[project]
+# name to use to infer config
+name = "superbol-studio-oss"
+
+# files used to locate the project top directory
+#   and to set the AUTOFONCE_SOURCE_DIR
+source_anchors = [ "import/gnucobol/tests/testsuite.at", "!" ]
+
+# files used to locate the project build directory
+#   where the _autofonce/ directory will be created
+#   and to set the AUTOFONCE_BUILD_DIR
+#   use "!" to trigger an error if build dir is mandatory
+build_anchors = [ "default" ]
+
+# paths in project sources that are good candidates to
+#   be tested as build dirs. Useful to run autofonce
+#   from outside the build directory
+build_dir_candidates = [ "_build" ]
+
+# where the _autofonce/ dir should be created:
+#   * 'build': in the build directory
+#   * 'source': in the source directory
+#   * 'config': in the directory of the config file
+run_from = "build"
+
+[testsuites]
+# alias = "path-from-topdir"
+[testsuites.testsuite]
+file = "import/gnucobol/tests/testsuite.at"
+path = [ "import/gnucobol/tests/testsuite.src"]
+env = "testsuite"
+
+[envs]
+# env_name = """..."""
+# env_name = "<local-path-to-env-file"
+testsuite = """
+export COMPILE_ONLY="$AUTOFONCE_BUILD_DIR/default/src/superbol/main.exe x-parse file"
+export COB_CONFIG_DIR="$AUTOFONCE_SOURCE_DIR/import/gnucobol/config"
+"""
+
+[project]
+# files to be captured into results.log
+#   in case of test failure.
+captured_files = [  ]
+

.drom

@@ -5,7 +5,7 @@ version:0.9.0
 
 # hash of toml configuration files
 # used for generation of all files
-306a162bd34aef4c3753c84e38852da6:.
+51efca4da0e63268b2046a7a0604ed40:.
 # end context for .
 
 # begin context for .github/workflows/workflow.yml
@@ -80,7 +80,7 @@ c8281f46ba9a11d0b61bc8ef67eaa357:docs/style.css
 
 # begin context for dune-project
 # file dune-project
-69659cb561ea7a5fbe7c54ac41297836:dune-project
+bc7c69c6baba24fa8481a31a1e33b88e:dune-project
 # end context for dune-project
 
 # begin context for opam/cobol_ast.opam
@@ -115,7 +115,7 @@ fea158982cf75a9547f3ef0d352851cb:opam/cobol_data.opam
 
 # begin context for opam/cobol_parser.opam
 # file opam/cobol_parser.opam
-e20b6d94b7638ca8bf1b1ed68291f39b:opam/cobol_parser.opam
+43dba93158fd4b90c93e2b7c9b770677:opam/cobol_parser.opam
 # end context for opam/cobol_parser.opam
 
 # begin context for opam/cobol_preproc.opam
@@ -335,7 +335,7 @@ f5b5ba58f2a9ef21787bfca4f4268580:src/lsp/cobol_lsp/dune
 
 # begin context for src/lsp/cobol_parser/dune
 # file src/lsp/cobol_parser/dune
-b68ae0e16fe9fde7a4b6b03d84be2680:src/lsp/cobol_parser/dune
+08706ca64cceec7220b7ffc2d654be97:src/lsp/cobol_parser/dune
 # end context for src/lsp/cobol_parser/dune
 
 # begin context for src/lsp/cobol_parser/version.mlt

dune-project

@@ -288,6 +288,7 @@
    (cobol_preproc (= version))
    (cobol_common (= version))
    (cobol_ast (= version))
+   (autofonce_lib ( >= 0.8 ))
    (menhir ( = 20220210 ))
    ppx_inline_test
    ppx_expect

opam/cobol_parser.opam

@@ -55,6 +55,7 @@ depends: [
   "cobol_preproc" {= version}
   "cobol_common" {= version}
   "cobol_ast" {= version}
+  "autofonce_lib" {>= "0.8"}
   "menhir" {= "20220210"}
   "ppx_inline_test" {with-test}
   "ppx_expect" {with-test}

src/lsp/cobol_parser/dune

@@ -5,7 +5,7 @@
   (public_name cobol_parser)
   (wrapped true)
   ; use field 'dune-libraries' to add libraries without opam deps
-  (libraries ppx_deriving menhirLib ez_file ebcdic_lib cobol_preproc cobol_common cobol_ast str)
+  (libraries ppx_deriving menhirLib ez_file ebcdic_lib cobol_preproc cobol_common cobol_ast autofonce_lib str)
   ; use field 'dune-flags' to set this value
   (flags (:standard))
   ; use field 'dune-stanzas' to add more stanzas here

src/lsp/cobol_parser/package.toml

@@ -59,6 +59,8 @@ cobol_preproc = "version"
 ebcdic_lib = "version"
 ez_file = ">=0.3"
 ppx_deriving = ">=5.2.1"
+autofonce_lib = ">=0.8"
+
 [dependencies.menhir]
 libname = "menhirLib"
 version = ">=1.2"

test/cobol_data/dune

@@ -0,0 +1,4 @@
+(tests
+  (names test_qualified_map)
+  (modules test_qualified_map)
+  (libraries alcotest cobol_data))

test/cobol_data/test_qualified_map.ml

@@ -0,0 +1,155 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Copyright (c) 2021-2023 OCamlPro SAS                                  *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*  This file is distributed under the terms of the                       *)
+(*  OCAMLPRO-NON-COMMERCIAL license.                                      *)
+(*                                                                        *)
+(**************************************************************************)
+open Cobol_ast
+open Cobol_common.Srcloc.INFIX
+
+type t =
+  | Elementary of string * int
+  | Group of string * int * t list
+
+let wss =
+  [Group ("Level 1", 0, [
+      Group ("Level 3", 1, [
+          Elementary ("Level 2", 2)]);
+      Group ("Level 4", 3,[
+          Elementary ("Level 2", 4)])
+    ]);
+   Group ("X", 0, [
+       Group ("Y", 5, [
+           Elementary ("Z", 10)
+         ])
+     ])
+  ]
+
+let unwrap = Result.get_ok
+let unwrap_err = Result.get_error
+let dummy_loc = Cobol_common.Srcloc.raw Lexing.(dummy_pos, dummy_pos)
+
+let rec qualname_of_str_list: string list -> qualname = function
+  | [] -> raise (Invalid_argument "The string list should not be empty")
+  | hd::[] -> Name (hd &@ dummy_loc)
+  | hd::tl -> Qual (hd &@ dummy_loc, qualname_of_str_list tl)
+
+
+let transform wss map =
+  let rec aux str_list map = function
+    | Group (name, elt, elts) ->
+        let str_list = name::str_list in
+        List.fold_left (aux str_list)
+          (Cobol_data.Qualmap.add (qualname_of_str_list str_list) elt map)
+          elts
+    | Elementary (name, elt) ->
+        Cobol_data.Qualmap.add (qualname_of_str_list (name::str_list)) elt map
+  in
+  aux [] map wss
+
+let wss = List.fold_left
+    (fun map grp ->
+       transform grp map)
+    Cobol_data.Qualmap.empty
+    wss
+
+let wss =
+  Cobol_data.Qualmap.add
+    (Qual ("Level 5" &@ dummy_loc,
+           Qual ("Level 3" &@ dummy_loc,
+                 Name ("Level 1" &@ dummy_loc))))
+    10
+    wss
+
+let elt = Alcotest.testable Format.pp_print_int (=)
+(* let error = Alcotest.testable *)
+(*     (fun fmt -> function `AmbiguousQualification qualname -> Format.fprintf fmt "Duplicate(@[%a@])" pp_qualname qualname) *)
+(*     (=) *)
+
+let qual n qn =
+  Qual (n &@ dummy_loc, qn)
+
+let name n: qualname =
+  Name (n &@ dummy_loc)
+
+let access_elt_1 () =
+  Alcotest.(check elt) "can access simple elt"
+    (Cobol_data.Qualmap.find (name "Level 1") wss) 0
+
+let access_elt_3 () =
+  Alcotest.(check elt) "can access simple sub element"
+    (Cobol_data.Qualmap.find (name "Level 3") wss) 1
+
+let access_elt_3_2 () =
+  Alcotest.(check elt) "can access qualified elt"
+    (Cobol_data.Qualmap.find (qual "Level 2" (name "Level 3")) wss) 2
+
+let access_elt_4_2 () =
+  Alcotest.(check elt) "can access qualified elt"
+    (Cobol_data.Qualmap.find (qual "Level 2" (name "Level 4")) wss) 4
+
+let duplicate_2 () =
+  let qualname: qualname = name "Level 2" in
+  Alcotest.check_raises "Not_found on ambiguous"
+    Not_found (fun () -> ignore @@ Cobol_data.Qualmap.find qualname wss)
+
+let bad_name () =
+  let qualname: qualname = qual "Y" (name "Z") in
+  Alcotest.check_raises "Not_found on bad name"
+    Not_found (fun () -> ignore @@ Cobol_data.Qualmap.find qualname wss)
+
+let access_elt_x_y_z () =
+  let qualname: qualname = qual "Z" (qual "Y" (name "X")) in
+  Alcotest.(check elt) "can access qualified elt"
+    (Cobol_data.Qualmap.find qualname wss) 10
+
+let access_elt_x_z () =
+  let qualname: qualname = qual "Z" (name "X") in
+  Alcotest.(check elt) "can access partial qualified elt"
+    (Cobol_data.Qualmap.find qualname wss) 10
+
+let bad_order () =
+  let qualname: qualname = qual "Z" (qual "X" (name "Y")) in
+  Alcotest.check_raises "Not_found on invalid name order"
+    Not_found (fun () -> ignore @@ Cobol_data.Qualmap.find qualname wss)
+
+(* let pp_print_str_list =
+  Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
+
+let pp_print_set fmt =
+  Cobol_data.Qualmap.(fun elt ->
+    pp_qualname fmt elt;
+    Format.pp_print_break fmt 2 0)
+
+let pp_print_map f fmt =
+  Cobol_data.Qualmap.iter (fun l elt ->
+    Format.fprintf fmt
+      "Key: %a; Value: %a;\n"
+      pp_qualname l
+      f elt)
+
+let pp_map fmt m =
+      Format.fprintf
+        fmt
+        "Bindings: @[<h>%a@]@;"
+        (pp_print_map Format.pp_print_int) m *)
+
+(* let _ =
+  Format.printf "%a" pp_map wss *)
+
+let () =
+  Alcotest.(run "qualified map" [
+      "access", [
+        test_case "Access Level 1" `Quick access_elt_1;
+        test_case "Access Level 3" `Quick access_elt_3;
+        test_case "Access Level 2 IN Level 3" `Quick access_elt_3_2;
+        test_case "Access Level 2 IN Level 4" `Quick access_elt_4_2;
+        test_case "Error on duplicate" `Quick duplicate_2;
+        test_case "Error on unknown name" `Quick bad_name;
+        test_case "Access Z OF Y OF X" `Quick access_elt_x_y_z;
+        test_case "Access Z OF X" `Quick access_elt_x_z;
+        test_case "Error on invalid order" `Quick bad_order;
+      ]])

test/cobol_parsing/cS_tokens.ml

@@ -0,0 +1,68 @@
+(******************************************************************************)
+(*                                                                            *)
+(*     Copyright (c) 2021-2023 OCamlPro SAS                                   *)
+(*                                                                            *)
+(*     All rights reserved.                                                   *)
+(*     This file is distributed under the terms of the                        *)
+(*     OCAMLPRO-NON-COMMERCIAL license.                                       *)
+(*                                                                            *)
+(******************************************************************************)
+
+let%expect_test "context-sensitive-tokens" =
+  Parser_testing.show_parsed_tokens {|
+       IDENTIFICATION     DIVISION.
+       PROGRAM-ID.        prog.
+       DATA               DIVISION.
+       WORKING-STORAGE    SECTION.
+       01  AWAY-FROM-ZERO PIC 9 VALUE 0.
+       01  BYTE-LENGTH    PIC 9.
+       01  X              CONSTANT AS BYTE-LENGTH OF BYTE-LENGTH.
+       01  Y              CONSTANT AS LENGTH OF BYTE-LENGTH.
+       PROCEDURE          DIVISION.
+           COMPUTE X ROUNDED MODE AWAY-FROM-ZERO
+                   AWAY-FROM-ZERO = 1.1
+           END-COMPUTE
+           DISPLAY X AWAY-FROM-ZERO NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+  |};
+  [%expect {|
+    IDENTIFICATION, DIVISION, ., PROGRAM-ID, ., WORD[PROG], ., DATA, DIVISION, .,
+    WORKING-STORAGE, SECTION, ., DIGITS[01], WORD[AWAY-FROM-ZERO], PICTURE,
+    PICTURE_STRING[9], VALUE, DIGITS[0], ., DIGITS[01], WORD[BYTE-LENGTH],
+    PICTURE, PICTURE_STRING[9], ., DIGITS[01], WORD[X], CONSTANT, AS,
+    BYTE-LENGTH, OF, WORD[BYTE-LENGTH], ., DIGITS[01], WORD[Y], CONSTANT, AS,
+    LENGTH, OF, WORD[BYTE-LENGTH], ., PROCEDURE, DIVISION, ., COMPUTE, WORD[X],
+    ROUNDED, MODE, AWAY-FROM-ZERO, WORD[AWAY-FROM-ZERO], =, FIXED[1.1],
+    END-COMPUTE, DISPLAY, WORD[X], WORD[AWAY-FROM-ZERO], NO, ADVANCING,
+    END-DISPLAY, ., STOP, RUN, ., EOF
+|}];;
+
+let%expect_test "context-sensitive-tokens-with-syntax-errors" =
+  Parser_testing.show_parsed_tokens {|
+       IDENTIFICATION     DIVISION.
+       PROGRAM-ID.        prog.
+       DATA               DIVISION.
+       WORKING-STORAGE    SECTION.
+       01  AWAY-FROM-ZERO PIC 9 VALUE 0.
+       01  BYTE-LENGTH    PIC 9.
+       01  X              CONSTANT AS BYTE-LENGTH BYTE-LENGTH.
+       01  Y              CONSTANT LENGTH OF BYTE-LENGTH.
+       PROCEDURE          DIVISION.
+           COMPUTE X ROUNDED AWAY-FROM-ZERO
+                   AWAY-FROM-ZERO = 1.1
+           END-COMPUTE
+           DISPLAY X AWAY-FROM-ZERO NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+  |};
+  [%expect {|
+    IDENTIFICATION, DIVISION, ., PROGRAM-ID, ., WORD[PROG], ., DATA, DIVISION, .,
+    WORKING-STORAGE, SECTION, ., DIGITS[01], WORD[AWAY-FROM-ZERO], PICTURE,
+    PICTURE_STRING[9], VALUE, DIGITS[0], ., DIGITS[01], WORD[BYTE-LENGTH],
+    PICTURE, PICTURE_STRING[9], ., DIGITS[01], WORD[X], CONSTANT, AS,
+    BYTE-LENGTH, WORD[BYTE-LENGTH], ., DIGITS[01], WORD[Y], CONSTANT, LENGTH, OF,
+    WORD[BYTE-LENGTH], ., PROCEDURE, DIVISION, ., COMPUTE, WORD[X], ROUNDED,
+    AWAY-FROM-ZERO, AWAY-FROM-ZERO, =, FIXED[1.1], END-COMPUTE, DISPLAY, WORD[X],
+    WORD[AWAY-FROM-ZERO], NO, ADVANCING, END-DISPLAY, ., STOP, RUN, ., EOF
+|}];;