From a2441c8619fafe8e7afa8e37f1a5ce408586f65b Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Thu, 5 Oct 2023 10:02:10 +0200 Subject: [PATCH] Finishing touches to the rewindable parser, with some tests --- src/lsp/cobol_lsp/lsp_document.ml | 15 +- src/lsp/cobol_parser/parser_engine.ml | 48 +- src/lsp/cobol_parser/text_lexer.ml | 13 +- src/lsp/cobol_parser/text_lexer.mli | 2 +- src/lsp/cobol_parser/text_tokenizer.ml | 3 +- src/lsp/cobol_preproc/preproc.ml | 6 +- src/lsp/cobol_preproc/preproc_engine.ml | 7 + src/lsp/cobol_preproc/preproc_engine.mli | 6 + test/cobol_parsing/dune | 20 +- test/cobol_parsing/parser_testing.ml | 189 +++++- test/cobol_parsing/test_appending.ml | 294 ++++++++++ test/cobol_parsing/test_appending_large.ml | 360 ++++++++++++ test/cobol_parsing/test_cutnpaste_large.ml | 648 +++++++++++++++++++++ test/output-tests/dune | 10 +- test/output-tests/preproc.ml | 33 +- test/output-tests/reparse.ml | 29 +- test/output-tests/testsuite_utils.ml | 49 ++ 17 files changed, 1626 insertions(+), 106 deletions(-) create mode 100644 test/cobol_parsing/test_appending.ml create mode 100644 test/cobol_parsing/test_appending_large.ml create mode 100644 test/cobol_parsing/test_cutnpaste_large.ml create mode 100644 test/output-tests/testsuite_utils.ml diff --git a/src/lsp/cobol_lsp/lsp_document.ml b/src/lsp/cobol_lsp/lsp_document.ml index b3b49c8ef..3688a9c04 100644 --- a/src/lsp/cobol_lsp/lsp_document.ml +++ b/src/lsp/cobol_lsp/lsp_document.ml @@ -169,18 +169,9 @@ let reparse_and_analyze ?position ({ copybook; rewinder; textdoc; _ } as doc) = { doc with artifacts = no_artifacts; rewinder = None; parsed = None } | Some position, Some rewinder -> extract_parsed_infos doc @@ - Cobol_parser.rewind_and_parse rewinder ~position - begin fun ?new_position pp -> - let contents = Lsp.Text_document.text textdoc in - let contents = match new_position with - | None -> contents - | Some (Lexing.{ pos_cnum; _ } as _pos) -> - EzString.after contents (pos_cnum - 1) - in - (* Pretty.error "contents = %S@." contents; *) - Cobol_preproc.reset_preprocessor ?new_position pp - (String { contents; filename = Lsp.Uri.to_path (uri doc) }) - end + Cobol_parser.rewind_and_parse rewinder ~position @@ + Cobol_preproc.reset_preprocessor_for_string @@ + Lsp.Text_document.text textdoc (** Creates a record for a document that is not yet parsed or analyzed. *) let blank ~project ?copybook textdoc = diff --git a/src/lsp/cobol_parser/parser_engine.ml b/src/lsp/cobol_parser/parser_engine.ml index e2dd80d8f..c06b3b3ab 100644 --- a/src/lsp/cobol_parser/parser_engine.ml +++ b/src/lsp/cobol_parser/parser_engine.ml @@ -519,9 +519,12 @@ module Make (Config: Cobol_config.T) = struct and ('a, 'm) rewindable_history_event = { preproc_position: Lexing.position; - event_stage: ('a, 'm) interim_stage; + event_stage: ('a, 'm) interim_stage_without_tokens; } + and ('a, 'm) interim_stage_without_tokens = + 'm state * 'a Grammar_interpr.env (* Always valid input_needed env. *) + let init_rewindable_parse ps ~make_checkpoint = { init = ps; @@ -530,17 +533,23 @@ module Make (Config: Cobol_config.T) = struct } (** Stores a stage as part of the memorized rewindable history events. *) - let save_history_event ((ps, _, _) as stage) (store: _ rewindable_history) = + let save_interim_stage (ps, _, env) (store: _ rewindable_history) = let preproc_position = Cobol_preproc.position ps.preproc.pp in match store with + | store' + when preproc_position.pos_cnum <> preproc_position.pos_bol -> + (* We must only save positions that correspond to beginning of lines; + this should only make us skip recording events at the end of + inputs. *) + store' | { preproc_position = prev_pos; _ } :: store' when prev_pos.pos_cnum = preproc_position.pos_cnum && prev_pos.pos_fname = preproc_position.pos_fname -> (* Preprocessor did not advance further since last save: replace event with new parser state: *) - { preproc_position; event_stage = stage } :: store' + { preproc_position; event_stage = (ps, env) } :: store' | store' -> - { preproc_position; event_stage = stage } :: store' + { preproc_position; event_stage = (ps, env) } :: store' let rewindable_parser_state = function | { stage = Final (_, ps) | Trans (ps, _, _); _ } -> ps @@ -560,7 +569,7 @@ module Make (Config: Cobol_config.T) = struct | Trans ((ps, _, _) as state) -> let store, count = if count = save_stage then store, succ count - else save_history_event state store, 0 + else save_interim_stage state store, 0 and stage = try on_interim_stage state with e -> on_exn ps e in @@ -574,15 +583,23 @@ module Make (Config: Cobol_config.T) = struct pos | Indexed { line; char } -> let ps = rewindable_parser_state rwps in - let lexpos = Cobol_preproc.position ps.preproc.pp in let newline_cnums = Cobol_preproc.newline_cnums ps.preproc.pp in - let pos_bol = - try List.nth newline_cnums (line - 1) - with Not_found | Invalid_argument _ -> 0 - in - Lexing.{ lexpos with pos_bol; - pos_cnum = pos_bol + char; - pos_lnum = line + 1 } + if newline_cnums = [] + then raise Not_found (* no complete line was processed yet; just skip *) + else + let lexpos = Cobol_preproc.position ps.preproc.pp in + try + let pos_bol = + try List.nth newline_cnums (line - 1) + with Not_found | Invalid_argument _ -> 0 + in + Lexing.{ lexpos with pos_bol; + pos_cnum = pos_bol + char; + pos_lnum = line + 1 } + with Failure _ -> + (* The given line exceeds what was already processed, so we restart + from the current preprocessor position. *) + lexpos let find_history_event_preceding ~position ({ store; _ } as rwps) = let lexpos = lexing_postion_of ~position rwps in @@ -608,10 +625,11 @@ module Make (Config: Cobol_config.T) = struct let rwps = try let event, store = find_history_event_preceding ~position rwps in - let ps, tokens, env = event.event_stage in + let ps, env = event.event_stage in let pp = ps.preproc.pp in - let pp = pp_rewind ?new_position:(Some event.preproc_position) pp in + let pp = pp_rewind ~new_position:event.preproc_position pp in let ps = { ps with preproc = { ps.preproc with pp } } in + let ps, tokens = produce_tokens ps in { rwps with stage = Trans (ps, tokens, env); store } with Not_found -> (* rewinding before first checkpoint *) let pp = pp_rewind rwps.init.preproc.pp in diff --git a/src/lsp/cobol_parser/text_lexer.ml b/src/lsp/cobol_parser/text_lexer.ml index dda4e55fc..2b5ec370f 100644 --- a/src/lsp/cobol_parser/text_lexer.ml +++ b/src/lsp/cobol_parser/text_lexer.ml @@ -109,15 +109,16 @@ module Make (Words: module type of Text_keywords) = struct let silenced_keywords = StringSet.of_list Words.silenced_keywords - let reserve_words: Cobol_config.words_spec -> unit = + let reserve_words: Cobol_config.words_spec -> DIAGS.Set.t = let on_token_handle_of kwd descr ~f = - try f @@ handle_of_keyword kwd with + try f @@ handle_of_keyword kwd; DIAGS.Set.none with | Not_found when StringSet.mem kwd silenced_keywords -> - () (* Ignore silently? Warn? *) + DIAGS.Set.none (* Ignore silently? Warn? *) | Not_found -> - Pretty.error "@[Unable@ to@ %s@ keyword:@ %s@]@." descr kwd + DIAGS.Set.error "@[Unable@ to@ %s@ keyword:@ %s@]@." descr kwd in - List.iter begin fun (w, word_spec) -> match word_spec with + List.fold_left begin fun diags (w, word_spec) -> + DIAGS.Set.union diags @@ match word_spec with | Cobol_config.ReserveWord { preserve_context_sensitivity } -> on_token_handle_of w "reserve" ~f:begin fun h -> if preserve_context_sensitivity @@ -132,7 +133,7 @@ module Make (Words: module type of Text_keywords) = struct end | NotReserved -> on_token_handle_of w "unreserve" ~f:unreserve_token - end + end DIAGS.Set.none let enable_tokens tokens = TokenHandles.iter enable_token tokens diff --git a/src/lsp/cobol_parser/text_lexer.mli b/src/lsp/cobol_parser/text_lexer.mli index fb36ebf3a..7aa6e28f4 100644 --- a/src/lsp/cobol_parser/text_lexer.mli +++ b/src/lsp/cobol_parser/text_lexer.mli @@ -31,7 +31,7 @@ val show_token_of_handle: token_handle -> string (* --- *) val handle_of_token: Grammar_tokens.token -> token_handle -val reserve_words: Cobol_config.words_spec -> unit +val reserve_words: Cobol_config.words_spec -> Cobol_common.Diagnostics.Set.t val enable_tokens: TokenHandles.t -> unit val disable_tokens: TokenHandles.t -> unit diff --git a/src/lsp/cobol_parser/text_tokenizer.ml b/src/lsp/cobol_parser/text_tokenizer.ml index 719fb762c..71c1b9d56 100644 --- a/src/lsp/cobol_parser/text_tokenizer.ml +++ b/src/lsp/cobol_parser/text_tokenizer.ml @@ -303,12 +303,11 @@ module Make (Config: Cobol_config.T) = struct let amnesic = Amnesic let eidetic = Eidetic [] let init memory ~context_sensitive_tokens = - init_text_lexer ~context_sensitive_tokens; { expect_picture_string = false; leftover_tokens = []; memory; - diags = DIAGS.Set.none; + diags = init_text_lexer ~context_sensitive_tokens; lexing_options = Text_lexer.default_lexing_options; } diff --git a/src/lsp/cobol_preproc/preproc.ml b/src/lsp/cobol_preproc/preproc.ml index b6f3a77fc..08bc387b7 100644 --- a/src/lsp/cobol_preproc/preproc.ml +++ b/src/lsp/cobol_preproc/preproc.ml @@ -101,9 +101,9 @@ let srclex_from_channel = make_srclex Lexing.from_channel let srclex_from_file ~source_format filename : any_srclexer = srclex_from_string ~source_format ~filename (EzFile.read_file filename) -(** Note: If given, assumes [position] corresponds to the begining of the - input. If absent, restarts from first position. File name is kept from the - previous input. *) +(** Note: If given, assumes [position] corresponds to the beginning of the + input, which {e must} also be at the beginning of a line. If absent, + restarts from first position. File name is kept from the previous input. *) let srclex_restart make_lexing ?position input (Plx (s, prev_lexbuf)) = let lexbuf = make_lexing ?with_positions:(Some true) input in let pos_fname = match position with diff --git a/src/lsp/cobol_preproc/preproc_engine.ml b/src/lsp/cobol_preproc/preproc_engine.ml index 390150a0d..0773084d7 100644 --- a/src/lsp/cobol_preproc/preproc_engine.ml +++ b/src/lsp/cobol_preproc/preproc_engine.ml @@ -390,6 +390,13 @@ let pp_pptokens: pptokens Pretty.printer = let reset_preprocessor ?new_position pp input = preprocessor input (`ResetPosition (pp, new_position)) +let reset_preprocessor_for_string string ?new_position pp = + let contents = match new_position with + | Some Lexing.{ pos_cnum; _ } -> EzString.after string (pos_cnum - 1) + | None -> string + in (* filename is ignored *) + reset_preprocessor ?new_position pp @@ String { contents; filename = "" } + (* --- *) let preprocessor ?(options = Preproc_options.default) input = diff --git a/src/lsp/cobol_preproc/preproc_engine.mli b/src/lsp/cobol_preproc/preproc_engine.mli index d6aebc9c4..0210debce 100644 --- a/src/lsp/cobol_preproc/preproc_engine.mli +++ b/src/lsp/cobol_preproc/preproc_engine.mli @@ -27,6 +27,12 @@ val reset_preprocessor -> preprocessor -> input -> preprocessor +val reset_preprocessor_for_string + : string + -> ?new_position:Lexing.position + -> preprocessor + -> preprocessor + (* --- *) diff --git a/test/cobol_parsing/dune b/test/cobol_parsing/dune index abef4bca8..93eaf3464 100644 --- a/test/cobol_parsing/dune +++ b/test/cobol_parsing/dune @@ -3,12 +3,28 @@ (modules test_picture_parsing test_combined_relations_parsing) (libraries alcotest cobol_parser cobol_data)) +(library + (name parser_testing) + (modules Parser_testing) + (libraries cobol_parser) + ) + (library (name test_cobol_parser) - (modules cS_tokens decimal_point tokens parser_testing) + (modules cS_tokens decimal_point tokens) (preprocess (pps ppx_expect)) (inline_tests (modes best)) ; add js for testing with nodejs - (libraries cobol_parser) + (libraries parser_testing) + ) + +(library + (name test_cobol_parser_rewind) + (modules test_appending test_appending_large test_cutnpaste_large) + (preprocess + (pps ppx_expect)) + (inline_tests + (modes best)) ; add js for testing with nodejs + (libraries parser_testing testsuite_utils) ) diff --git a/test/cobol_parsing/parser_testing.ml b/test/cobol_parsing/parser_testing.ml index 7019b004b..b1e8f1be9 100644 --- a/test/cobol_parsing/parser_testing.ml +++ b/test/cobol_parsing/parser_testing.ml @@ -12,24 +12,201 @@ (**************************************************************************) module DIAGS = Cobol_common.Diagnostics +module StrMap = EzCompat.StringMap let show_parsed_tokens ?(verbose = false) ?(source_format = Cobol_config.(SF SFFixed)) prog = let DIAGS.{ result = WithArtifacts (_, { tokens; _ }); _ } = + String { filename = "prog.cob"; contents = prog } |> + Cobol_preproc.preprocessor + ~options:Cobol_preproc.Options.{ + default with + libpath = []; + source_format + } |> Cobol_parser.parse_with_artifacts ~options:Cobol_parser.Options.{ default with verbose; recovery = EnableRecovery { silence_benign_recoveries = true }; - } @@ + } + in + Cobol_parser.INTERNAL.pp_tokens Fmt.stdout (Lazy.force tokens) + +(* --- *) + +(** Structure returned by {!extract_position_markers} below. *) +type positions = + { + pos_anonymous: position list; + pos_map: position StrMap.t; + } +and position = + { + line: int; + char: int; + cnum: int; + } + +let position_marker = "_|_\\|_|[0-9a-zA-Z-+]+|_" +let position_or_newline_regexp = Str.(regexp @@ position_marker ^ "\\|\n") + +(** [extract_position_markers text] records and removes any cursor position + marker from [text], and returns the resulting text along with a set of + cursor positions. + + Anonymous markers are denoted {[_|_]}. They are listed in order of + appearance in [text] ([pos_anonymous]). + + Named markers are denoted {[_|some-name|_]}, where {[some-name]} may + comprise alphanumeric and [+] or [-] characters. They are recorded in + [pos_map]. *) +let extract_position_markers + ?(with_start_pos = true) ?(with_end_pos = true) + text = + let splits = Str.full_split position_or_newline_regexp text in + let positions = + if with_start_pos + then [{ line = 0; char = 0; cnum = 0 }, None] + else [] + in + let acc, line, char, cnum, positions = + List.fold_left begin fun (acc, line, char, cnum, positions) -> function + | Str.Text t -> + let len = String.length t in + t :: acc, line, char + len, cnum + len, positions + | Str.Delim "\n" -> + "\n" :: acc, succ line, 0, cnum + 1, positions + | Str.Delim "_|_" -> + acc, line, char, cnum, ({ line; char; cnum }, + None) :: positions + | Str.Delim d -> + let position_ident = Scanf.sscanf d "_|%s@|_" Fun.id in + acc, line, char, cnum, ({ line; char; cnum }, + Some position_ident) :: positions + end ([], 0, 0, 0, positions) splits + in + let positions = + if with_end_pos + then ({ line; char; cnum }, None) :: positions + else positions + in + String.concat "" (List.rev acc), + List.fold_left begin fun acc (pos, ident) -> + match ident with + | None -> { acc with pos_anonymous = pos :: acc.pos_anonymous } + | Some id -> { acc with pos_map = StrMap.add id pos acc.pos_map } + end { pos_anonymous = []; pos_map = StrMap.empty } positions + +let insert_periodic_position_markers ?(period = 1) prog = + let rec aux acc prog = + if String.length prog <= period + then + String.concat "_|_" (List.rev (prog :: acc)) + else + let chunk, rem = EzString.before prog period, + EzString.after prog (period - 1) in + aux (chunk :: acc) rem + in + aux [] prog + +let pairwise positions = + List.(combine (rev (tl (rev positions))) (tl positions)) + +(* --- *) + +let rewindable_parse + ?(verbose = false) + ?(source_format = Cobol_config.(SF SFFixed)) + ?config + prog + = + let DIAGS.{ result = Only ptree, rewinder; diags } = + String { filename = "prog.cob"; contents = prog } |> Cobol_preproc.preprocessor ~options:Cobol_preproc.Options.{ + verbose; libpath = []; source_format; + config = Option.value config ~default:default.config; + } |> + Cobol_parser.rewindable_parse_simple + ~options:Cobol_parser.Options.{ default with - libpath = []; - source_format - } @@ - String { filename = "prog.cob"; contents = prog } + verbose; recovery = DisableRecovery; + config = Option.value config ~default:default.config; + } in - Cobol_parser.INTERNAL.pp_tokens Fmt.stdout (Lazy.force tokens) + ptree, diags, rewinder + +let rewind_n_parse ~f rewinder { line; char; _ } preproc_rewind = + let DIAGS.{ result = Only ptree, rewinder; diags } = + Cobol_parser.rewind_and_parse rewinder preproc_rewind + ~position:(Indexed { line; char }) + in + f ptree diags; + rewinder + +(** [iteratively_append_chunks ?config ~f (prog, positions)] starts a rewindable + parser on a first chunk of input (until the first position in + [positions.pos_anonymous]), and then iteralively appends the remaining + chunks (from one position to the next). [f] is called after each successive + chunk has been parsed, with chunk number and total number of chunks as first + and second arguments, respectively. *) +let iteratively_append_chunks ?config ~f (prog, positions) = + let _, _, rewinder = + rewindable_parse ?config @@ (* start with first chunk of input *) + EzString.before prog (List.hd positions.pos_anonymous).cnum + in + let num_chunks = List.length positions.pos_anonymous - 1 in + ignore @@ List.fold_left begin fun (i, rewinder) (pos, next_pos) -> + let prog = EzString.before prog next_pos.cnum in + Pretty.out "Appending chunk %u/%u @@ %d:%d-%d:%d (%a)@." + i num_chunks + pos.line pos.char next_pos.line next_pos.char + Fmt.(truncated ~max:30) + Pretty.(to_string "%S" @@ EzString.after prog (pos.cnum - 1)); + succ i, + rewind_n_parse ~f:(f i num_chunks) rewinder pos + (Cobol_preproc.reset_preprocessor_for_string prog) + end (1, rewinder) (pairwise positions.pos_anonymous) + +(** [simulate_cut_n_paste ?config ~f (prog, positions)] starts a rewindable + parser on [prog], and then repeatedly cuts a chunk [c] form the input (from + one position to the next in [positions.pos_anonymous]), try to parse, and + paste [c] back in its original place. [f0] is called once at the very + beginning with the results obtained by parsing the original program [prog]. + [f] is called after a chunk has been cut and pasted back. *) +let simulate_cut_n_paste ?config ~f0 ~f ?(repeat = 1) (prog, positions) = + Random.init 42; + let ptree0, diags, rewinder = rewindable_parse ?config prog in + f0 ~ptree0 diags; + let positions = Array.of_list positions.pos_anonymous in + let num_chunks = Array.length positions - 1 in + let rec loop i rewinder = + if i < repeat then begin + let chunk_num = Random.int num_chunks in (* pick a chunk *) + let pos = positions.(chunk_num) + and next_pos = positions.(chunk_num + 1) in + let chunk = + EzString.(after (before prog next_pos.cnum) (pos.cnum - 1)) in + Pretty.out "Cutting chunk %u/%u @@ %d:%d-%d:%d (%a)@." + chunk_num num_chunks + pos.line pos.char next_pos.line next_pos.char + Fmt.(truncated ~max:30) Pretty.(to_string "%S" chunk); + let prog_prefix = EzString.before prog pos.cnum + and prog_suffix = EzString.after prog (next_pos.cnum - 1) in + let rewinder = + rewind_n_parse ~f:(fun _ _ -> ()) rewinder pos @@ + Cobol_preproc.reset_preprocessor_for_string @@ + prog_prefix ^ prog_suffix + in + Pretty.out "Putting it back@."; + let rewinder = + rewind_n_parse ~f:(f chunk_num num_chunks ~ptree0) rewinder pos @@ + Cobol_preproc.reset_preprocessor_for_string prog + in + loop (succ i) rewinder + end + in + loop 0 rewinder diff --git a/test/cobol_parsing/test_appending.ml b/test/cobol_parsing/test_appending.ml new file mode 100644 index 000000000..1e26df8a1 --- /dev/null +++ b/test/cobol_parsing/test_appending.ml @@ -0,0 +1,294 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let pp_ptree = + Fmt.option Cobol_parser.PTree.pp_compilation_group + ~none:(Fmt.any "None") + +let show_ptree _i _n ptree _diags = + Pretty.out "@[Parse-tree:@;%a@]@\n@." pp_ptree ptree + +(* --- *) + +let%expect_test "line-by-line-incremental-small-1" = + Parser_testing.iteratively_append_chunks ~f:show_ptree @@ + Parser_testing.extract_position_markers {| +_|_ IDENTIFICATION DIVISION. +_|_ PROGRAM-ID. prog. +_|_ PROCEDURE DIVISION. +_|_ STOP RUN. + |}; + [%expect {| + Appending chunk 1/5 @ 0:0-1:0 ("\n") + Parse-tree: + + + Appending chunk 2/5 @ 1:0-2:0 (" IDENTIFICATION DIV...) + Parse-tree: + None + + Appending chunk 3/5 @ 2:0-3:0 (" PROGRAM-ID. prog.\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 4/5 @ 3:0-4:0 (" PROCEDURE DIVISION...) + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 5/5 @ 4:0-5:2 (" STOP RUN.\n ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. +|}];; + +let%expect_test "line-by-line-incremental-small-2" = + Parser_testing.iteratively_append_chunks ~f:show_ptree @@ + Parser_testing.extract_position_markers {| + _|_ IDENTIFICATION DIVISION. + _|_ PROGRAM-ID. prog. + _|_ PROCEDURE DIVISION. + _|_ STOP RUN. + |}; + [%expect {| + Appending chunk 1/5 @ 0:0-1:7 ("\n ") + Parse-tree: + + + Appending chunk 2/5 @ 1:7-2:7 (" IDENTIFICATION DIVISION.\...) + Parse-tree: + None + + Appending chunk 3/5 @ 2:7-3:7 (" PROGRAM-ID. prog.\n ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 4/5 @ 3:7-4:7 (" PROCEDURE DIVISION.\n ...) + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 5/5 @ 4:7-5:2 (" STOP RUN.\n ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. +|}];; + +let%expect_test "line-by-line-incremental-small-3" = + Parser_testing.iteratively_append_chunks ~f:show_ptree @@ + Parser_testing.extract_position_markers {| +_|_ IDENTIFICATION DIVISION._|_ +_|_ PROGRAM-ID. prog._|_ +_|_ PROCEDURE DIVISION._|_ +_|_ STOP RUN._|_ + |}; + [%expect {| + Appending chunk 1/9 @ 0:0-1:0 ("\n") + Parse-tree: + + + Appending chunk 2/9 @ 1:0-1:32 (" IDENTIFICATION DIV...) + Parse-tree: + None + + Appending chunk 3/9 @ 1:32-2:0 ("\n") + Parse-tree: + None + + Appending chunk 4/9 @ 2:0-2:25 (" PROGRAM-ID. prog.") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 5/9 @ 2:25-3:0 ("\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 6/9 @ 3:0-3:27 (" PROCEDURE DIVISION.") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 7/9 @ 3:27-4:0 ("\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 8/9 @ 4:0-4:21 (" STOP RUN.") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. + + Appending chunk 9/9 @ 4:21-5:2 ("\n ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. +|}];; + +let%expect_test "line-by-line-incremental-small-4" = + Parser_testing.iteratively_append_chunks ~f:show_ptree @@ + Parser_testing.extract_position_markers @@ + Parser_testing.insert_periodic_position_markers ~period:5 {| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + STOP RUN. + |}; + [%expect {| + Appending chunk 1/23 @ 0:0-1:4 ("\n ") + Parse-tree: + + + Appending chunk 2/23 @ 1:4-1:9 (" I") + Parse-tree: + None + + Appending chunk 3/23 @ 1:9-1:14 ("DENTI") + Parse-tree: + None + + Appending chunk 4/23 @ 1:14-1:19 ("FICAT") + Parse-tree: + None + + Appending chunk 5/23 @ 1:19-1:24 ("ION D") + Parse-tree: + None + + Appending chunk 6/23 @ 1:24-1:29 ("IVISI") + Parse-tree: + None + + Appending chunk 7/23 @ 1:29-2:1 ("ON.\n ") + Parse-tree: + None + + Appending chunk 8/23 @ 2:1-2:6 (" ") + Parse-tree: + None + + Appending chunk 9/23 @ 2:6-2:11 (" PRO") + Parse-tree: + None + + Appending chunk 10/23 @ 2:11-2:16 ("GRAM-") + Parse-tree: + None + + Appending chunk 11/23 @ 2:16-2:21 ("ID. p") + Parse-tree: + None + + Appending chunk 12/23 @ 2:21-3:0 ("rog.\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 13/23 @ 3:0-3:5 (" ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + + Appending chunk 14/23 @ 3:5-3:10 (" PR") + Parse-tree: + None + + Appending chunk 15/23 @ 3:10-3:15 ("OCEDU") + Parse-tree: + None + + Appending chunk 16/23 @ 3:15-3:20 ("RE DI") + Parse-tree: + None + + Appending chunk 17/23 @ 3:20-3:25 ("VISIO") + Parse-tree: + None + + Appending chunk 18/23 @ 3:25-4:2 ("N.\n ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 19/23 @ 4:2-4:7 (" ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 20/23 @ 4:7-4:12 (" ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + + + Appending chunk 21/23 @ 4:12-4:17 ("STOP ") + Parse-tree: + None + + Appending chunk 22/23 @ 4:17-5:0 ("RUN.\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. + + Appending chunk 23/23 @ 5:0-5:2 (" ") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + PROCEDURE DIVISION. + STOP RUN. +|}];; diff --git a/test/cobol_parsing/test_appending_large.ml b/test/cobol_parsing/test_appending_large.ml new file mode 100644 index 000000000..5ca326445 --- /dev/null +++ b/test/cobol_parsing/test_appending_large.ml @@ -0,0 +1,360 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file +open FileString.OP +open Testsuite_utils (* implemented in `../output-tests' *) + +let show_last_ptree i n ptree diags = + if i = n then Test_appending.show_ptree i n ptree diags + +let%expect_test "line-by-line-incremental-mf" = + (* find . \( -type f -a -iname '*.cbl' \) -printf '%s %p\n' | sort -nr | head *) + (* 6554 ./ReportWriter/RepWriteSumm.cbl *) + (* 6543 ./ReportWriter/RepWriteFull.cbl *) + (* 6093 ./SubProg/DayDiff/DayDiffDriver.cbl *) + (* 4493 ./SubProg/Multiply/DriverProg.cbl *) + (* 4477 ./Strings/RefMod.cbl *) + (* 3821 ./ReportWriter/RepWriteB.cbl *) + (* 3156 ./SeqRpt/SeqRpt.CBL *) + (* 3142 ./ReportWriter/RepWriteA.cbl *) + (* 3087 ./Strings/UnstringFileEg.cbl *) + (* 2413 ./SubProg/DateValid/ValiDate.cbl *) + let config = + Testsuite_utils.from_dialect ~strict:true Cobol_config.DIALECT.MicroFocus in + deep_iter mf_root ~glob:"RepWriteSumm.[cC][bB][lL]" (* <- pick largest file *) + ~f:begin fun path -> + let file = srcdir // mf_testsuite // path in + Pretty.out "Considering `%s'.@." file; + Parser_testing.iteratively_append_chunks ~config ~f:show_last_ptree @@ + Parser_testing.extract_position_markers @@ + Parser_testing.insert_periodic_position_markers ~period:42 @@ + FileString.read_file file; + end; + end_with_postproc [%expect.output]; + [%expect {| + Loading configuration from + `__srcdir__/import/gnucobol/config/mf-strict.conf' + Considering `__srcdir__/test/testsuite/microfocus/www.csis.ul.ie/ReportWriter/RepWriteSumm.cbl'. + Appending chunk 1/157 @ 0:0-1:10 (" $ SET SOURCEFORMAT\"...) + Appending chunk 2/157 @ 1:10-2:26 ("TION DIVISION.\r\nPROGRAM-...) + Appending chunk 3/157 @ 2:26-5:2 ("Summary.\r\nAUTHOR. Micha...) + Appending chunk 4/157 @ 5:2-6:21 ("VIRONMENT DIVISION.\r\nINP...) + Appending chunk 5/157 @ 6:21-8:25 ("\r\nFILE-CONTROL.\r\n S...) + Appending chunk 6/157 @ 8:25-9:21 ("GN TO \"GBSALES.DAT\"\r\n ...) + Appending chunk 7/157 @ 9:21-10:18 ("ON IS LINE SEQUENTIAL.\r\n...) + Appending chunk 8/157 @ 10:18-12:0 ("le ASSIGN TO \"SUMMARYSALE...) + Appending chunk 9/157 @ 12:0-15:9 ("\r\nDATA DIVISION.\r\nFILE...) + Appending chunk 10/157 @ 15:9-17:17 ("File.\r\n01 SalesRecord.\...) + Appending chunk 11/157 @ 17:17-18:21 (" VALUE HIGH-VALUES.\r\n ...) + Appending chunk 12/157 @ 18:21-19:31 (" PIC 9.\r\n 02 SalesP...) + Appending chunk 13/157 @ 19:31-22:1 ("\n 02 ValueOfSale ...) + Appending chunk 14/157 @ 22:1-24:0 ("D PrintFile\r\n REPORT...) + Appending chunk 15/157 @ 24:0-26:14 ("\r\nWORKING-STORAGE SECTIO...) + Appending chunk 16/157 @ 26:14-28:19 ("\r\n 02 TableValues.\r\...) + Appending chunk 17/157 @ 28:19-28:61 (" PIC X(18) VALUE \"Dub...) + Appending chunk 18/157 @ 28:61-29:40 ("\r\n 03 FILLER ...) + Appending chunk 19/157 @ 29:40-30:19 ("\"Cork Galway \".\r\...) + Appending chunk 20/157 @ 30:19-30:61 (" PIC X(18) VALUE \"Sli...) + Appending chunk 21/157 @ 30:61-31:40 ("\r\n 03 FILLER ...) + Appending chunk 22/157 @ 31:40-32:29 ("\"Limerick\".\r\n 02 FI...) + Appending chunk 23/157 @ 32:29-33:33 ("Values.\r\n 03 CityN...) + Appending chunk 24/157 @ 33:33-36:8 ("CCURS 7 TIMES.\r\n\r\n01 ...) + Appending chunk 25/157 @ 36:8-37:29 ("ableValues.\r\n 03 F...) + Appending chunk 26/157 @ 37:29-38:36 ("(35)\r\n ...) + Appending chunk 27/157 @ 38:36-39:8 ("32100435005670012300234003...) + Appending chunk 28/157 @ 39:8-40:15 ("3 FILLER PIC X(35)\...) + Appending chunk 29/157 @ 40:15-40:57 (" VALUE \"123005430...) + Appending chunk 30/157 @ 40:57-41:29 ("220013300\".\r\n 03 ...) + Appending chunk 31/157 @ 41:29-42:36 ("(35)\r\n ...) + Appending chunk 32/157 @ 42:36-43:8 ("32100176001870013300144001...) + Appending chunk 33/157 @ 43:8-44:15 ("3 FILLER PIC X(35)\...) + Appending chunk 34/157 @ 44:15-44:57 (" VALUE \"321001230...) + Appending chunk 35/157 @ 44:57-45:29 ("770018800\".\r\n 03 ...) + Appending chunk 36/157 @ 45:29-46:36 ("(35)\r\n ...) + Appending chunk 37/157 @ 46:36-47:8 ("34500456005430011100122001...) + Appending chunk 38/157 @ 47:8-48:15 ("3 FILLER PIC X(35)\...) + Appending chunk 39/157 @ 48:15-48:57 (" VALUE \"190001800...) + Appending chunk 40/157 @ 48:57-49:29 ("330022200\".\r\n 03 ...) + Appending chunk 41/157 @ 49:29-50:36 ("(35)\r\n ...) + Appending chunk 42/157 @ 50:36-51:8 ("15600145001460022200111002...) + Appending chunk 43/157 @ 51:8-52:15 ("3 FILLER PIC X(35)\...) + Appending chunk 44/157 @ 52:15-52:57 (" VALUE \"120001320...) + Appending chunk 45/157 @ 52:57-53:29 ("210043200\".\r\n 03 ...) + Appending chunk 46/157 @ 53:29-54:36 ("(35)\r\n ...) + Appending chunk 47/157 @ 54:36-56:6 ("16500164001760011100777003...) + Appending chunk 48/157 @ 56:6-57:10 (" FILLER REDEFINES TableVal...) + Appending chunk 49/157 @ 57:10-58:20 ("City OCCURS 7 TIMES.\r\n ...) + Appending chunk 50/157 @ 58:20-60:7 ("te PIC 9(3)V99 OCCURS 9 T...) + Appending chunk 51/157 @ 60:7-61:29 ("cVariables.\r\n 02 Comm...) + Appending chunk 52/157 @ 61:29-62:33 ("(4)V99.\r\n 02 Percenta...) + Appending chunk 53/157 @ 62:33-63:31 ("ALUE .05.\r\n 02 Salary...) + Appending chunk 54/157 @ 63:31-65:3 (")V99.\r\n 02 SalesPerso...) + Appending chunk 55/157 @ 65:3-68:9 (" 02 CityNow PIC 9...) + Appending chunk 56/157 @ 68:9-70:17 ("CTION.\r\nRD SalesReport\...) + Appending chunk 57/157 @ 70:17-72:9 ("FINAL\r\n C...) + Appending chunk 58/157 @ 72:9-73:18 (" SalesPersonNum \r\n...) + Appending chunk 59/157 @ 73:18-76:3 ("66\r\n HEADING 1\r\n ...) + Appending chunk 60/157 @ 76:3-79:6 (" LAST DETAIL 42\r\n FOO...) + Appending chunk 61/157 @ 79:6-81:5 ("PE IS PAGE HEADING.\r\n ...) + Appending chunk 62/157 @ 81:5-82:12 (" 03 COLUMN 12 PIC X(3...) + Appending chunk 63/157 @ 82:12-82:54 (" VALUE \"An exa...) + Appending chunk 64/157 @ 82:54-85:12 (" Program\".\r\n\r\n 02 ...) + Appending chunk 65/157 @ 85:12-86:19 ("LUMN 6 PIC X(17)\r\n ...) + Appending chunk 66/157 @ 86:19-87:23 ("ble Salesperson\".\r\n ...) + Appending chunk 67/157 @ 87:23-88:30 (" PIC X(26)\r\n VA...) + Appending chunk 68/157 @ 88:30-91:7 ("Salary Report\".\r\n\r\n ...) + Appending chunk 69/157 @ 91:7-92:1 ("03 COLUMN 2 PIC X(4) ...) + Appending chunk 70/157 @ 92:1-92:43 (" 03 COLUMN 12 PIC...) + Appending chunk 71/157 @ 92:43-93:29 ("lesperson\".\r\n 03 ...) + Appending chunk 72/157 @ 93:29-96:5 ("(4) VALUE \"Sale\".\r\n\r\...) + Appending chunk 73/157 @ 96:5-96:47 (" 03 COLUMN 2 PIC X(4...) + Appending chunk 74/157 @ 96:47-97:41 ("\n 03 COLUMN 13 ...) + Appending chunk 75/157 @ 97:41-98:33 ("umber\".\r\n 03 COLU...) + Appending chunk 76/157 @ 98:33-101:22 ("VALUE \"Value\".\r\n\r\n\r...) + Appending chunk 77/157 @ 101:22-103:8 (" DETAIL.\r\n 02 LINE IS...) + Appending chunk 78/157 @ 103:8-104:16 ("3 COLUMN 1 PIC X(9)\r...) + Appending chunk 79/157 @ 104:16-104:58 (" SOURCE CityName(Ci...) + Appending chunk 80/157 @ 104:58-106:2 ("DICATE.\r\n 03 COLUM...) + Appending chunk 81/157 @ 106:2-106:44 (" SOUR...) + Appending chunk 82/157 @ 106:44-107:22 ("m GROUP INDICATE.\r\n ...) + Appending chunk 83/157 @ 107:22-109:1 (" PIC $$,$$$.99 SOURCE Val...) + Appending chunk 84/157 @ 109:1-111:21 ("\n01 SalesPersonGrp\r\n ...) + Appending chunk 85/157 @ 111:21-111:63 ("OOTING SalesPersonNum NEX...) + Appending chunk 86/157 @ 111:63-113:17 ("\n 02 LINE IS PLUS 1.\r...) + Appending chunk 87/157 @ 113:17-113:59 ("15 PIC X(21) VALUE \"S...) + Appending chunk 88/157 @ 113:59-114:35 ("son\".\r\n 03 COLUMN...) + Appending chunk 89/157 @ 114:35-115:23 ("E SalesPersonNum.\r\n ...) + Appending chunk 90/157 @ 115:23-116:23 (" PIC X VALUE \"=\".\r\n ...) + Appending chunk 91/157 @ 116:23-118:4 (" PIC $$$$$,$$$.99 SUM Valu...) + Appending chunk 92/157 @ 118:4-119:22 ("02 LINE IS PLUS 1.\r\n ...) + Appending chunk 93/157 @ 119:22-120:0 (" PIC X(19) VALUE \"Sales ...) + Appending chunk 94/157 @ 120:0-121:0 (" 03 COLUMN 43 PI...) + Appending chunk 95/157 @ 121:0-121:42 (" 03 COLUMN 45 PI...) + Appending chunk 96/157 @ 121:42-123:21 ("OURCE Commission.\r\n\r\n ...) + Appending chunk 97/157 @ 123:21-124:39 (".\r\n 03 COLUMN 15 ...) + Appending chunk 98/157 @ 124:39-125:15 (" \"Salesperson salary is\"...) + Appending chunk 99/157 @ 125:15-126:15 ("N 43 PIC X VALUE \"=\"...) + Appending chunk 100/157 @ 126:15-127:0 ("N 45 PIC $$$$$,$$$.99 ...) + Appending chunk 101/157 @ 127:0-129:16 ("\r\n 02 LINE IS PLUS 1....) + Appending chunk 102/157 @ 129:16-130:23 (" 15 PIC X(30)\r\n ...) + Appending chunk 103/157 @ 130:23-131:0 (" VALUE \"Current salesper...) + Appending chunk 104/157 @ 131:0-131:42 (" 03 COLUMN 45 PI...) + Appending chunk 105/157 @ 131:42-134:4 ("PersonNow.\r\n\r\n 02 L...) + Appending chunk 106/157 @ 134:4-135:11 (" 03 COLUMN 15 PIC X(...) + Appending chunk 107/157 @ 135:11-135:53 (" VALUE \"Previ...) + Appending chunk 108/157 @ 135:53-136:30 ("umber = \".\r\n 03 C...) + Appending chunk 109/157 @ 136:30-140:12 ("SOURCE SalesPersonNum.\r\n...) + Appending chunk 110/157 @ 140:12-140:54 ("TYPE IS CONTROL FOOTING Ci...) + Appending chunk 111/157 @ 140:54-142:7 ("P PLUS 2.\r\n 02 LINE I...) + Appending chunk 112/157 @ 142:7-142:49 ("03 COLUMN 15 PIC X(9) ...) + Appending chunk 113/157 @ 142:49-143:38 ("\".\r\n 03 COLUMN 25...) + Appending chunk 114/157 @ 143:38-144:19 ("E CityName(CityCode).\r\n ...) + Appending chunk 115/157 @ 144:19-145:19 (" PIC X VALUE \"=\".\r\...) + Appending chunk 116/157 @ 145:19-147:8 (" 45 PIC $$$$$,$$$.99 SUM ...) + Appending chunk 117/157 @ 147:8-148:26 ("INE IS PLUS 1.\r\n 0...) + Appending chunk 118/157 @ 148:26-149:33 ("C X(12)\r\n ...) + Appending chunk 119/157 @ 149:33-150:28 ("rrent city\".\r\n 03...) + Appending chunk 120/157 @ 150:28-151:28 ("X VALUE \"=\".\r\n 0...) + Appending chunk 121/157 @ 151:28-153:21 ("9 SOURCE CityNow.\r\n\r\n ...) + Appending chunk 122/157 @ 153:21-155:4 (".\r\n 03 COLUMN 15 ...) + Appending chunk 123/157 @ 155:4-155:46 (" VALUE ...) + Appending chunk 124/157 @ 155:46-156:40 ("\r\n 03 COLUMN 43 ...) + Appending chunk 125/157 @ 156:40-157:40 ("\r\n 03 COLUMN 45 ...) + Appending chunk 126/157 @ 157:40-160:28 ("ityCode.\r\n\r\n\r\n01 To...) + Appending chunk 127/157 @ 160:28-161:20 ("NTROL FOOTING FINAL.\r\n ...) + Appending chunk 128/157 @ 161:20-163:3 ("4.\r\n 03 COLUMN 15 ...) + Appending chunk 129/157 @ 163:3-163:45 (" VALUE...) + Appending chunk 130/157 @ 163:45-164:41 ("\n 03 COLUMN 43 ...) + Appending chunk 131/157 @ 164:41-165:41 ("\n 03 COLUMN 45 ...) + Appending chunk 132/157 @ 165:41-169:2 ("SUM CS.\r\n\r\n\r\n01 TYP...) + Appending chunk 133/157 @ 169:2-170:24 (" 02 LINE IS 53.\r\n ...) + Appending chunk 134/157 @ 170:24-170:66 ("PIC X(29) VALUE \"Programm...) + Appending chunk 135/157 @ 170:66-171:34 ("hlan\".\r\n 03 COLUM...) + Appending chunk 136/157 @ 171:34-172:26 ("ALUE \"Page :\".\r\n ...) + Appending chunk 137/157 @ 172:26-175:11 ("C Z9 SOURCE PAGE-COUNTER.\...) + Appending chunk 138/157 @ 175:11-178:2 ("IVISION.\r\nDECLARATIVES.\...) + Appending chunk 139/157 @ 178:2-179:2 (" USE BEFORE REPORTING Sal...) + Appending chunk 140/157 @ 179:2-180:25 ("lculate-Salary.\r\n MUL...) + Appending chunk 141/157 @ 180:25-181:35 ("ntage\r\n GIVING ...) + Appending chunk 142/157 @ 181:35-182:39 (".\r\n ADD Commission, F...) + Appending chunk 143/157 @ 182:39-183:24 ("SalesPersonNum )\r\n ...) + Appending chunk 144/157 @ 183:24-187:4 ("\r\nEND DECLARATIVES.\r\n\...) + Appending chunk 145/157 @ 187:4-189:11 ("n.\r\n OPEN INPUT Sales...) + Appending chunk 146/157 @ 189:11-191:5 ("TPUT PrintFile.\r\n REA...) + Appending chunk 147/157 @ 191:5-192:8 (" AT END SET EndOfFile T...) + Appending chunk 148/157 @ 192:8-194:8 ("READ.\r\n INITIATE Sale...) + Appending chunk 149/157 @ 194:8-195:19 ("ORM PrintSalaryReport\r\n ...) + Appending chunk 150/157 @ 195:19-197:3 ("ndOfFile.\r\n TERMINATE...) + Appending chunk 151/157 @ 197:3-198:12 (" CLOSE SalesFile, PrintFil...) + Appending chunk 152/157 @ 198:12-202:15 (".\r\n\r\n\r\nPrintSalaryRe...) + Appending chunk 153/157 @ 202:15-203:26 ("de TO CityNow.\r\n MOVE...) + Appending chunk 154/157 @ 203:26-204:23 ("O SalesPersonNow.\r\n G...) + Appending chunk 155/157 @ 204:23-206:18 ("t.\r\n READ SalesFile\r...) + Appending chunk 156/157 @ 206:18-210:1 ("ET EndOfFile TO TRUE\r\n ...) + Appending chunk 157/157 @ 210:1-211:0 ("\r\n") + Parse-tree: + IDENTIFICATION DIVISION. + PROGRAM-ID. REPORTEXAMPLESUMMARY. + AUTHOR. MICHAEL COUGHLAN . + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT SALESFILE ASSIGN "GBSALES.DAT" SEQUENTIAL. + SELECT PRINTFILE ASSIGN "SUMMARYSALESREPORT.LPT". + DATA DIVISION. + FILE SECTION. + FD SALESFILE. + 01 SALESRECORD. + 88 ENDOFFILE VALUE HIGH-VALUES. + 02 CITYCODE PIC 9. + 02 SALESPERSONNUM PIC 9. + 02 VALUEOFSALE PIC 9(4)V99. + FD PRINTFILE + REPORT IS SALESREPORT. + WORKING-STORAGE SECTION. + 01 NAMETABLE. + 02 TABLEVALUES. + 03 FILLER PIC X(18) VALUE "Dublin Belfast ". + 03 FILLER PIC X(18) VALUE "Cork Galway ". + 03 FILLER PIC X(18) VALUE "Sligo Waterford". + 03 FILLER PIC X(9) VALUE "Limerick". + 02 FILLER REDEFINES TABLEVALUES. + 03 CITYNAME PIC X(9) OCCURS 7. + 01 RATETABLE. + 02 TABLEVALUES. + 03 FILLER PIC X(35) VALUE "12300321004350056700123002340034500". + 03 FILLER PIC X(35) VALUE "12300543001230034200111001220013300". + 03 FILLER PIC X(35) VALUE "12000321001760018700133001440015500". + 03 FILLER PIC X(35) VALUE "32100123003210012000166001770018800". + 03 FILLER PIC X(35) VALUE "34500345004560054300111001220013200". + 03 FILLER PIC X(35) VALUE "19000180001780017900444003330022200". + 03 FILLER PIC X(35) VALUE "16700156001450014600222001110021200". + 03 FILLER PIC X(35) VALUE "12000132001230014300121003210043200". + 03 FILLER PIC X(35) VALUE "15400165001640017600111007770033300". + 02 FILLER REDEFINES TABLEVALUES. + 03 CITY OCCURS 7. + 04 FIXEDRATE PIC 9(3)V99 OCCURS 9. + 01 MISCVARIABLES. + 02 COMMISSION PIC 9(4)V99. + 02 PERCENTAGE PIC V99 VALUE .05. + 02 SALARY PIC 9(6)V99. + 02 SALESPERSONNOW PIC 9. + 02 CITYNOW PIC 9. + REPORT SECTION. + RD SALESREPORT + CONTROL FINAL CITYCODE + SALESPERSONNUM + PAGE LIMIT IS 66 LINES + HEADING 1 + FIRST DETAIL 6 + LAST DETAIL 42 + FOOTING 52. + 01 TYPE PH. + 02 LINE NUMBER 1. + 03 COLUMN LEFT 12 PIC X(32) VALUE "An example COBOL Report Program". + 02 LINE NUMBER 2. + 03 COLUMN LEFT 6 PIC X(17) VALUE "Bible Salesperson". + 03 COLUMN LEFT 23 PIC X(26) VALUE " - Sales and Salary Report". + 02 LINE NUMBER 4. + 03 COLUMN LEFT 2 PIC X(4) VALUE "City". + 03 COLUMN LEFT 12 PIC X(11) VALUE "Salesperson". + 03 COLUMN LEFT 28 PIC X(4) VALUE "Sale". + 02 LINE NUMBER 5. + 03 COLUMN LEFT 2 PIC X(4) VALUE "Name". + 03 COLUMN LEFT 13 PIC X(6) VALUE "Number". + 03 COLUMN LEFT 28 PIC X(5) VALUE "Value". + 01 DETAILLINE TYPE DETAIL. + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 1 PIC X(9) SOURCE CITYNAME(CITYCODE) GROUP. + 03 COLUMN LEFT 15 PIC 9 SOURCE SALESPERSONNUM GROUP. + 03 COLUMN LEFT 25 PIC $$,$$$.99 SOURCE VALUEOFSALE . + 01 SALESPERSONGRP TYPE CF FOR SALESPERSONNUM NEXT GROUP IS PLUS 2. + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(21) VALUE "Sales for salesperson". + 03 COLUMN LEFT 37 PIC 9 SOURCE SALESPERSONNUM . + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 SMS COLUMN LEFT 45 PIC $$$$$,$$$.99 SUM VALUEOFSALE . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(19) VALUE "Sales commission is". + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 COLUMN LEFT 45 PIC $$$$$,$$$.99 SOURCE COMMISSION . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(22) VALUE "Salesperson salary is". + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 COLUMN LEFT 45 PIC $$$$$,$$$.99 SOURCE SALARY . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(30) VALUE "Current salesperson number = ". + 03 COLUMN LEFT 45 PIC 9 SOURCE SALESPERSONNOW . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(30) VALUE "Previous salesperson number = ". + 03 COLUMN LEFT 45 PIC 9 SOURCE SALESPERSONNUM . + 01 CITYGRP TYPE CF FOR CITYCODE NEXT GROUP IS PLUS 2. + 02 LINE NUMBER PLUS 2. + 03 COLUMN LEFT 15 PIC X(9) VALUE "Sales for". + 03 COLUMN LEFT 25 PIC X(9) SOURCE CITYNAME(CITYCODE) . + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 CS COLUMN LEFT 45 PIC $$$$$,$$$.99 SUM SMS . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(12) VALUE "Current city". + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 COLUMN LEFT 45 PIC 9 SOURCE CITYNOW . + 02 LINE NUMBER PLUS 1. + 03 COLUMN LEFT 15 PIC X(13) VALUE "Previous city". + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 COLUMN LEFT 45 PIC 9 SOURCE CITYCODE . + 01 TOTALSALESGRP TYPE CF FOR FINAL. + 02 LINE NUMBER PLUS 4. + 03 COLUMN LEFT 15 PIC X(11) VALUE "Total sales". + 03 COLUMN LEFT 43 PIC X VALUE "=". + 03 COLUMN LEFT 45 PIC $$$$$,$$$.99 SUM CS . + 01 TYPE PF. + 02 LINE NUMBER 53. + 03 COLUMN LEFT 1 PIC X(29) VALUE "Programmer - Michael Coughlan". + 03 COLUMN LEFT 45 PIC X(6) VALUE "Page :". + 03 COLUMN LEFT 52 PIC Z9 SOURCE PAGE-COUNTER . + PROCEDURE DIVISION. + DECLARATIVES. + CALC SECTION. + USE BEFORE REPORTING SALESPERSONGRP. + CALCULATE-SALARY. + MULTIPLY SMS BY PERCENTAGE GIVING COMMISSION ROUNDED END-MULTIPLY. + ADD COMMISSION TO FIXEDRATE(CITYCODE, SALESPERSONNUM) GIVING SALARY END-ADD. + END DECLARATIVES. + MAIN SECTION. + + BEGIN. + OPEN INPUT SALESFILE. + + OPEN OUTPUT PRINTFILE. + + READ SALESFILE AT END SET ENDOFFILE TO TRUE END-READ. + + INITIATE SALESREPORT. + + PERFORM PRINTSALARYREPORT UNTIL ENDOFFILE. + + TERMINATE SALESREPORT. + + CLOSE SALESFILE PRINTFILE. + + STOP RUN. + PRINTSALARYREPORT. + MOVE CITYCODE TO CITYNOW. + + MOVE SALESPERSONNUM TO SALESPERSONNOW. + + GENERATE SALESREPORT. + + READ SALESFILE AT END SET ENDOFFILE TO TRUE END-READ. +|}];; diff --git a/test/cobol_parsing/test_cutnpaste_large.ml b/test/cobol_parsing/test_cutnpaste_large.ml new file mode 100644 index 000000000..a6aee6423 --- /dev/null +++ b/test/cobol_parsing/test_cutnpaste_large.ml @@ -0,0 +1,648 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file +open FileString.OP +open Testsuite_utils (* implemented in `../output-tests' *) + +let check_initial_ptree ~ptree0 diags = + if ptree0 = None then begin + Pretty.out "%a@." Cobol_common.Diagnostics.Set.pp diags; + Pretty.failwith "Unable to parse the original program."; + end + +let check_new_ptree i n ~ptree0 ptree' diags = + if Option.compare + Cobol_parser.PTree.compare_compilation_group ptree0 ptree' = 0 + then Pretty.out "Ok@." + else Test_appending.show_ptree i n ptree0 diags + +let%expect_test "cut-n-paste-mf" = + let config = + Testsuite_utils.from_dialect ~strict:true Cobol_config.DIALECT.MicroFocus in + deep_iter mf_root ~glob:"DayDiffDriver.[cC][bB][lL]" (* <- pick large-ish file *) + ~f:begin fun path -> + let file = srcdir // mf_testsuite // path in + Pretty.out "Considering `%s'.@." file; + Parser_testing.simulate_cut_n_paste ~config ~repeat:200 + ~f0:check_initial_ptree ~f:check_new_ptree @@ + Parser_testing.extract_position_markers @@ + Parser_testing.insert_periodic_position_markers ~period:51 @@ + FileString.read_file file; + end; + end_with_postproc [%expect.output]; + [%expect {| + Loading configuration from + `__srcdir__/import/gnucobol/config/mf-strict.conf' + Considering `__srcdir__/test/testsuite/microfocus/www.csis.ul.ie/SubProg/DayDiff/DayDiffDriver.cbl'. + Cutting chunk 54/120 @ 75:10-79:7 ("RFORM DisplayErrorMessage\...) + Putting it back + Ok + Cutting chunk 15/120 @ 15:41-18:9 ("uroDate\" is used to conve...) + Putting it back + Ok + Cutting chunk 63/120 @ 91:60-93:29 ("t\r\n EVALUATE TRUE\r\n...) + Putting it back + Ok + Cutting chunk 33/120 @ 45:14-47:13 ("tValidFirstDate UNTIL Date...) + Putting it back + Ok + Cutting chunk 57/120 @ 81:68-83:19 ("NCING.\r\n ACCEPT Secon...) + Putting it back + Ok + Cutting chunk 35/120 @ 48:31-50:25 ("UNTIL DateIsValid.\r\n ...) + Putting it back + Ok + Cutting chunk 114/120 @ 184:7-187:7 ("ference ...) + Putting it back + Ok + Cutting chunk 41/120 @ 56:32-57:24 ("ING FirstDate, FirstDate.\...) + Putting it back + Ok + Cutting chunk 11/120 @ 12:41-13:21 ("ser and the date required ...) + Putting it back + Ok + Cutting chunk 58/120 @ 83:19-84:16 (" USING BY CONTENT Seco...) + Putting it back + Ok + Cutting chunk 81/120 @ 121:24-122:31 (" PIC XX.\r\n ...) + Putting it back + Ok + Cutting chunk 40/120 @ 54:40-56:32 (" DayDifference.\r\n\r\n ...) + Putting it back + Ok + Cutting chunk 15/120 @ 15:41-18:9 ("uroDate\" is used to conve...) + Putting it back + Ok + Cutting chunk 96/120 @ 151:10-153:24 ("CTION.\r\n01 YYYYDDMMDate...) + Putting it back + Ok + Cutting chunk 100/120 @ 157:41-159:44 ("8).\r\n\r\nPROCEDURE DIVIS...) + Putting it back + Ok + Cutting chunk 106/120 @ 172:3-174:2 ("GRAM-ID. GetDayDiff.\r\nAU...) + Putting it back + Ok + Cutting chunk 6/120 @ 8:12-9:8 ("yDiff\" program is include...) + Putting it back + Ok + Cutting chunk 1/120 @ 1:29-3:21 ("E\"\r\nIDENTIFICATION DIVI...) + Putting it back + Ok + Cutting chunk 17/120 @ 20:21-22:34 ("ON.\r\n01 Dates.\r\n 0...) + Putting it back + Ok + Cutting chunk 11/120 @ 12:41-13:21 ("ser and the date required ...) + Putting it back + Ok + Cutting chunk 75/120 @ 110:19-113:5 ("N.\r\nDATA DIVISION.\r\nWO...) + Putting it back + Ok + Cutting chunk 63/120 @ 91:60-93:29 ("t\r\n EVALUATE TRUE\r\n...) + Putting it back + Ok + Cutting chunk 89/120 @ 138:22-140:14 ("N.\r\nPROGRAM-ID. SortDate...) + Putting it back + Ok + Cutting chunk 62/120 @ 91:9-91:60 ("AY \"Invalid date . Return...) + Putting it back + Ok + Cutting chunk 85/120 @ 128:26-130:5 ("YYYDay.\r\n MOVE DDMMMo...) + Putting it back + Ok + Cutting chunk 73/120 @ 107:6-108:27 (". Michael Coughlan.\r\n...) + Putting it back + Ok + Cutting chunk 41/120 @ 56:32-57:24 ("ING FirstDate, FirstDate.\...) + Putting it back + Ok + Cutting chunk 113/120 @ 183:2-184:7 (" Date2 ...) + Putting it back + Ok + Cutting chunk 68/120 @ 96:32-97:16 ("DISPLAY \"Day contains all...) + Putting it back + Ok + Cutting chunk 54/120 @ 75:10-79:7 ("RFORM DisplayErrorMessage\...) + Putting it back + Ok + Cutting chunk 80/120 @ 120:17-121:24 (" PIC XX.\...) + Putting it back + Ok + Cutting chunk 59/120 @ 84:16-85:7 (" BY REFERENCE V...) + Putting it back + Ok + Cutting chunk 12/120 @ 13:21-14:18 ("ogram are in different for...) + Putting it back + Ok + Cutting chunk 109/120 @ 175:48-176:49 ("\r\n* The first date passe...) + Putting it back + Ok + Cutting chunk 119/120 @ 195:2-197:0 ("D PROGRAM DayDriver.\r\n\r\n") + Putting it back + Ok + Cutting chunk 108/120 @ 174:53-175:48 ("o\r\n* Dates. The dates mu...) + Putting it back + Ok + Cutting chunk 73/120 @ 107:6-108:27 (". Michael Coughlan.\r\n...) + Putting it back + Ok + Cutting chunk 109/120 @ 175:48-176:49 ("\r\n* The first date passe...) + Putting it back + Ok + Cutting chunk 61/120 @ 86:34-91:9 ("e\r\n END-IF.\r\n\r\n\r...) + Putting it back + Ok + Cutting chunk 20/120 @ 24:46-25:46 ("XX.\r\n 02 SecondDatePr...) + Putting it back + Ok + Cutting chunk 28/120 @ 36:13-37:20 ("ontainsZeros VALUE...) + Putting it back + Ok + Cutting chunk 58/120 @ 83:19-84:16 (" USING BY CONTENT Seco...) + Putting it back + Ok + Cutting chunk 24/120 @ 31:34-32:43 ("PIC 9.\r\n 88 DateIsVal...) + Putting it back + Ok + Cutting chunk 105/120 @ 167:17-172:3 ("ateToEuroDate.\r\n\r\n\r\n...) + Putting it back + Ok + Cutting chunk 40/120 @ 54:40-56:32 (" DayDifference.\r\n\r\n ...) + Putting it back + Ok + Cutting chunk 64/120 @ 93:29-94:16 (" DISPLAY \"Date is not n...) + Putting it back + Ok + Cutting chunk 67/120 @ 95:50-96:32 ("tains all zeros.\"\r\n ...) + Putting it back + Ok + Cutting chunk 27/120 @ 35:6-36:13 (" YearContainsZeros ...) + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 94/120 @ 148:0-149:7 (" 02 DDMMMonth ...) + Putting it back + Ok + Cutting chunk 110/120 @ 176:49-179:3 ("cond\r\n* Date and the dif...) + Putting it back + Ok + Cutting chunk 37/120 @ 51:17-53:1 ("eToSortDate\" USING Second...) + Putting it back + Ok + Cutting chunk 93/120 @ 146:12-148:0 ("Temp.\r\n 02 DDMMDay ...) + Putting it back + Ok + Cutting chunk 47/120 @ 63:16-64:5 ("ondDatePrn \" is \" DayDif...) + Putting it back + Ok + Cutting chunk 3/120 @ 5:17-6:5 ("ts the difference in days ...) + Putting it back + Ok + Cutting chunk 96/120 @ 151:10-153:24 ("CTION.\r\n01 YYYYDDMMDate...) + Putting it back + Ok + Cutting chunk 14/120 @ 14:69-15:41 ("Y format\r\n* to YYYYMMDD ...) + Putting it back + Ok + Cutting chunk 103/120 @ 163:12-164:27 ("YYear TO DDMMYear.\r\n...) + Putting it back + Ok + Cutting chunk 33/120 @ 45:14-47:13 ("tValidFirstDate UNTIL Date...) + Putting it back + Ok + Cutting chunk 6/120 @ 8:12-9:8 ("yDiff\" program is include...) + Putting it back + Ok + Cutting chunk 106/120 @ 172:3-174:2 ("GRAM-ID. GetDayDiff.\r\nAU...) + Putting it back + Ok + Cutting chunk 87/120 @ 131:20-134:10 ("P TO YYYYDDMMDate.\r\n ...) + Putting it back + Ok + Cutting chunk 51/120 @ 71:17-72:45 ("ate.\r\n CALL \"Validat...) + Putting it back + Ok + Cutting chunk 14/120 @ 14:69-15:41 ("Y format\r\n* to YYYYMMDD ...) + Putting it back + Ok + Cutting chunk 112/120 @ 181:15-183:2 (".\r\n01 Date1 ...) + Putting it back + Ok + Cutting chunk 90/120 @ 140:14-141:34 ("chael Coughlan.\r\n* Conve...) + Putting it back + Ok + Cutting chunk 14/120 @ 14:69-15:41 ("Y format\r\n* to YYYYMMDD ...) + Putting it back + Ok + Cutting chunk 104/120 @ 164:27-167:17 ("MMYYYYDate.\r\n EXIT PR...) + Putting it back + Ok + Cutting chunk 51/120 @ 71:17-72:45 ("ate.\r\n CALL \"Validat...) + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 90/120 @ 140:14-141:34 ("chael Coughlan.\r\n* Conve...) + Putting it back + Ok + Cutting chunk 36/120 @ 50:25-51:17 ("ate\" USING FirstDate, Fir...) + Putting it back + Ok + Cutting chunk 91/120 @ 141:34-144:3 ("at to one in DDMMYYYY\r\n\...) + Putting it back + Ok + Cutting chunk 108/120 @ 174:53-175:48 ("o\r\n* Dates. The dates mu...) + Putting it back + Ok + Cutting chunk 59/120 @ 84:16-85:7 (" BY REFERENCE V...) + Putting it back + Ok + Cutting chunk 44/120 @ 59:20-60:34 ("O FirstDatePrn.\r\n MOV...) + Putting it back + Ok + Cutting chunk 116/120 @ 188:6-190:24 ("\r\n COMPUTE Difference ...) + Putting it back + Ok + Cutting chunk 101/120 @ 159:44-161:33 ("YYYDate.\r\nBegin.\r\n ...) + Putting it back + Ok + Cutting chunk 17/120 @ 20:21-22:34 ("ON.\r\n01 Dates.\r\n 0...) + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 101/120 @ 159:44-161:33 ("YYYDate.\r\nBegin.\r\n ...) + Putting it back + Ok + Cutting chunk 109/120 @ 175:48-176:49 ("\r\n* The first date passe...) + Putting it back + Ok + Cutting chunk 33/120 @ 45:14-47:13 ("tValidFirstDate UNTIL Date...) + Putting it back + Ok + Cutting chunk 69/120 @ 97:16-98:8 ("hGreaterThan12 DISPLAY \"...) + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 83/120 @ 124:34-126:37 (" PIC X(8).\r\n\r\nPROCEDUR...) + Putting it back + Ok + Cutting chunk 111/120 @ 179:3-181:15 ("IRONMENT DIVISION.\r\nDATA...) + Putting it back + Ok + Cutting chunk 26/120 @ 33:50-35:6 ("\n 88 DateNotNumeric ...) + Putting it back + Ok + Cutting chunk 119/120 @ 195:2-197:0 ("D PROGRAM DayDriver.\r\n\r\n") + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 60/120 @ 85:7-86:34 ("DateIsNotValid \r\n ...) + Putting it back + Ok + Cutting chunk 107/120 @ 174:2-174:53 ("This module finds the diff...) + Putting it back + Ok + Cutting chunk 25/120 @ 32:43-33:50 ("\n 88 DateIsNotValid ...) + Putting it back + Ok + Cutting chunk 108/120 @ 174:53-175:48 ("o\r\n* Dates. The dates mu...) + Putting it back + Ok + Cutting chunk 14/120 @ 14:69-15:41 ("Y format\r\n* to YYYYMMDD ...) + Putting it back + Ok + Cutting chunk 25/120 @ 32:43-33:50 ("\n 88 DateIsNotValid ...) + Putting it back + Ok + Cutting chunk 110/120 @ 176:49-179:3 ("cond\r\n* Date and the dif...) + Putting it back + Ok + Cutting chunk 114/120 @ 184:7-187:7 ("ference ...) + Putting it back + Ok + Cutting chunk 16/120 @ 18:9-20:21 ("NT DIVISION.\r\nDATA DIVIS...) + Putting it back + Ok + Cutting chunk 4/120 @ 6:5-6:56 ("calls three contained subp...) + Putting it back + Ok + Cutting chunk 18/120 @ 22:34-23:40 ("PIC X(8).\r\n 02 Second...) + Putting it back + Ok + Cutting chunk 75/120 @ 110:19-113:5 ("N.\r\nDATA DIVISION.\r\nWO...) + Putting it back + Ok + Cutting chunk 111/120 @ 179:3-181:15 ("IRONMENT DIVISION.\r\nDATA...) + Putting it back + Ok + Cutting chunk 74/120 @ 108:27-110:19 ("YY format to one in YYYYMM...) + Putting it back + Ok + Cutting chunk 109/120 @ 175:48-176:49 ("\r\n* The first date passe...) + Putting it back + Ok + Cutting chunk 34/120 @ 47:13-48:31 ("sNotValid TO TRUE.\r\n ...) + Putting it back + Ok + Cutting chunk 32/120 @ 43:4-45:14 ("n.\r\n SET DateIsNotVal...) + Putting it back + Ok + Cutting chunk 23/120 @ 29:34-31:34 ("PIC ----,--9.\r\n\r\n01 V...) + Putting it back + Ok + Cutting chunk 59/120 @ 84:16-85:7 (" BY REFERENCE V...) + Putting it back + Ok + Cutting chunk 26/120 @ 33:50-35:6 ("\n 88 DateNotNumeric ...) + Putting it back + Ok + Cutting chunk 114/120 @ 184:7-187:7 ("ference ...) + Putting it back + Ok + Cutting chunk 28/120 @ 36:13-37:20 ("ontainsZeros VALUE...) + Putting it back + Ok + Cutting chunk 36/120 @ 50:25-51:17 ("ate\" USING FirstDate, Fir...) + Putting it back + Ok + Cutting chunk 119/120 @ 195:2-197:0 ("D PROGRAM DayDriver.\r\n\r\n") + Putting it back + Ok + Cutting chunk 30/120 @ 38:27-39:34 (" VALUE 5.\r\n 88 ...) + Putting it back + Ok + Cutting chunk 11/120 @ 12:41-13:21 ("ser and the date required ...) + Putting it back + Ok + Cutting chunk 109/120 @ 175:48-176:49 ("\r\n* The first date passe...) + Putting it back + Ok + Cutting chunk 45/120 @ 60:34-62:25 ("rn.\r\n DISPLAY SPACES....) + Putting it back + Ok + Cutting chunk 86/120 @ 130:5-131:20 ("OVE DDMMYear TO YYYYYe...) + Putting it back + Ok + Cutting chunk 118/120 @ 190:75-195:2 ("\r\n EXIT PROGRAM.\r\n\r...) + Putting it back + Ok + Cutting chunk 112/120 @ 181:15-183:2 (".\r\n01 Date1 ...) + Putting it back + Ok + Cutting chunk 102/120 @ 161:33-163:12 ("\r\n MOVE YYYYMonth ...) + Putting it back + Ok + Cutting chunk 20/120 @ 24:46-25:46 ("XX.\r\n 02 SecondDatePr...) + Putting it back + Ok + Cutting chunk 30/120 @ 38:27-39:34 (" VALUE 5.\r\n 88 ...) + Putting it back + Ok + Cutting chunk 1/120 @ 1:29-3:21 ("E\"\r\nIDENTIFICATION DIVI...) + Putting it back + Ok + Cutting chunk 25/120 @ 32:43-33:50 ("\n 88 DateIsNotValid ...) + Putting it back + Ok + Cutting chunk 8/120 @ 9:59-11:12 ("een\r\n* two dates entered...) + Putting it back + Ok + Cutting chunk 34/120 @ 47:13-48:31 ("sNotValid TO TRUE.\r\n ...) + Putting it back + Ok + Cutting chunk 104/120 @ 164:27-167:17 ("MMYYYYDate.\r\n EXIT PR...) + Putting it back + Ok + Cutting chunk 72/120 @ 105:14-107:6 (" DIVISION.\r\nPROGRAM-ID. ...) + Putting it back + Ok + Cutting chunk 9/120 @ 11:12-11:63 ("entered by the user are va...) + Putting it back + Ok + Cutting chunk 61/120 @ 86:34-91:9 ("e\r\n END-IF.\r\n\r\n\r...) + Putting it back + Ok + Cutting chunk 59/120 @ 84:16-85:7 (" BY REFERENCE V...) + Putting it back + Ok + Cutting chunk 7/120 @ 9:8-9:59 ("gram and is used to get th...) + Putting it back + Ok + Cutting chunk 100/120 @ 157:41-159:44 ("8).\r\n\r\nPROCEDURE DIVIS...) + Putting it back + Ok + Cutting chunk 93/120 @ 146:12-148:0 ("Temp.\r\n 02 DDMMDay ...) + Putting it back + Ok + Cutting chunk 31/120 @ 39:34-43:4 ("VALUE 6.\r\n \r...) + Putting it back + Ok + Cutting chunk 22/120 @ 28:29-29:34 (" PIC S9(7).\r\n 02 ...) + Putting it back + Ok + Cutting chunk 93/120 @ 146:12-148:0 ("Temp.\r\n 02 DDMMDay ...) + Putting it back + Ok + Cutting chunk 90/120 @ 140:14-141:34 ("chael Coughlan.\r\n* Conve...) + Putting it back + Ok + Cutting chunk 99/120 @ 155:36-157:41 ("IC XX.\r\n\r\n01 DDMMYYYY...) + Putting it back + Ok + Cutting chunk 33/120 @ 45:14-47:13 ("tValidFirstDate UNTIL Date...) + Putting it back + Ok + Cutting chunk 116/120 @ 188:6-190:24 ("\r\n COMPUTE Difference ...) + Putting it back + Ok + Cutting chunk 45/120 @ 60:34-62:25 ("rn.\r\n DISPLAY SPACES....) + Putting it back + Ok + Cutting chunk 46/120 @ 62:25-63:16 ("ce between \" FirstDatePrn...) + Putting it back + Ok + Cutting chunk 99/120 @ 155:36-157:41 ("IC XX.\r\n\r\n01 DDMMYYYY...) + Putting it back + Ok + Cutting chunk 55/120 @ 79:7-81:17 ("dSecondDate.\r\n DISPLA...) + Putting it back + Ok + Cutting chunk 33/120 @ 45:14-47:13 ("tValidFirstDate UNTIL Date...) + Putting it back + Ok + Cutting chunk 43/120 @ 58:14-59:20 ("fference TO DayDifferenceP...) + Putting it back + Ok + Cutting chunk 54/120 @ 75:10-79:7 ("RFORM DisplayErrorMessage\...) + Putting it back + Ok + Cutting chunk 99/120 @ 155:36-157:41 ("IC XX.\r\n\r\n01 DDMMYYYY...) + Putting it back + Ok + Cutting chunk 44/120 @ 59:20-60:34 ("O FirstDatePrn.\r\n MOV...) + Putting it back + Ok + Cutting chunk 81/120 @ 121:24-122:31 (" PIC XX.\r\n ...) + Putting it back + Ok + Cutting chunk 39/120 @ 53:52-54:40 ("econdDate\r\n ...) + Putting it back + Ok + Cutting chunk 50/120 @ 70:42-71:17 ("YYYY format \" WITH NO ADV...) + Putting it back + Ok + Cutting chunk 77/120 @ 114:37-115:42 ("C XXXX.\r\n 02 YYYYMont...) + Putting it back + Ok + Cutting chunk 97/120 @ 153:24-154:29 (" PIC XXXX.\r\n ...) + Putting it back + Ok + Cutting chunk 115/120 @ 187:7-188:6 ("RE DIVISION USING Date1, D...) + Putting it back + Ok + Cutting chunk 111/120 @ 179:3-181:15 ("IRONMENT DIVISION.\r\nDATA...) + Putting it back + Ok + Cutting chunk 92/120 @ 144:3-146:12 ("A DIVISION.\r\nWORKING-STO...) + Putting it back + Ok + Cutting chunk 6/120 @ 8:12-9:8 ("yDiff\" program is include...) + Putting it back + Ok + Cutting chunk 36/120 @ 50:25-51:17 ("ate\" USING FirstDate, Fir...) + Putting it back + Ok + Cutting chunk 79/120 @ 118:3-120:17 ("KAGE SECTION.\r\n01 DDMMY...) + Putting it back + Ok + Cutting chunk 119/120 @ 195:2-197:0 ("D PROGRAM DayDriver.\r\n\r\n") + Putting it back + Ok + Cutting chunk 45/120 @ 60:34-62:25 ("rn.\r\n DISPLAY SPACES....) + Putting it back + Ok + Cutting chunk 23/120 @ 29:34-31:34 ("PIC ----,--9.\r\n\r\n01 V...) + Putting it back + Ok + Cutting chunk 40/120 @ 54:40-56:32 (" DayDifference.\r\n\r\n ...) + Putting it back + Ok + Cutting chunk 67/120 @ 95:50-96:32 ("tains all zeros.\"\r\n ...) + Putting it back + Ok + Cutting chunk 15/120 @ 15:41-18:9 ("uroDate\" is used to conve...) + Putting it back + Ok + Cutting chunk 1/120 @ 1:29-3:21 ("E\"\r\nIDENTIFICATION DIVI...) + Putting it back + Ok + Cutting chunk 15/120 @ 15:41-18:9 ("uroDate\" is used to conve...) + Putting it back + Ok + Cutting chunk 80/120 @ 120:17-121:24 (" PIC XX.\...) + Putting it back + Ok + Cutting chunk 84/120 @ 126:37-128:26 (", YYYYDDMMDate.\r\nBegin.\...) + Putting it back + Ok + Cutting chunk 78/120 @ 115:42-118:3 ("\r\n 02 YYYYDay ...) + Putting it back + Ok + Cutting chunk 72/120 @ 105:14-107:6 (" DIVISION.\r\nPROGRAM-ID. ...) + Putting it back + Ok + Cutting chunk 74/120 @ 108:27-110:19 ("YY format to one in YYYYMM...) + Putting it back + Ok + Cutting chunk 75/120 @ 110:19-113:5 ("N.\r\nDATA DIVISION.\r\nWO...) + Putting it back + Ok + Cutting chunk 76/120 @ 113:5-114:37 ("YYYDDMMTemp.\r\n 02 YYY...) + Putting it back + Ok + Cutting chunk 6/120 @ 8:12-9:8 ("yDiff\" program is include...) + Putting it back + Ok + Cutting chunk 79/120 @ 118:3-120:17 ("KAGE SECTION.\r\n01 DDMMY...) + Putting it back + Ok + Cutting chunk 92/120 @ 144:3-146:12 ("A DIVISION.\r\nWORKING-STO...) + Putting it back + Ok + Cutting chunk 27/120 @ 35:6-36:13 (" YearContainsZeros ...) + Putting it back + Ok + Cutting chunk 76/120 @ 113:5-114:37 ("YYYDDMMTemp.\r\n 02 YYY...) + Putting it back + Ok + Cutting chunk 108/120 @ 174:53-175:48 ("o\r\n* Dates. The dates mu...) + Putting it back + Ok + Cutting chunk 118/120 @ 190:75-195:2 ("\r\n EXIT PROGRAM.\r\n\r...) + Putting it back + Ok + Cutting chunk 106/120 @ 172:3-174:2 ("GRAM-ID. GetDayDiff.\r\nAU...) + Putting it back + Ok + Cutting chunk 13/120 @ 14:18-14:69 ("ortDate\" subprogram is us...) + Putting it back + Ok + Cutting chunk 108/120 @ 174:53-175:48 ("o\r\n* Dates. The dates mu...) + Putting it back + Ok + Cutting chunk 116/120 @ 188:6-190:24 ("\r\n COMPUTE Difference ...) + Putting it back + Ok + Cutting chunk 80/120 @ 120:17-121:24 (" PIC XX.\...) + Putting it back + Ok + Cutting chunk 6/120 @ 8:12-9:8 ("yDiff\" program is include...) + Putting it back + Ok + Cutting chunk 65/120 @ 94:16-94:67 ("ContainsZeros DISPLAY \"...) + Putting it back + Ok + Cutting chunk 56/120 @ 81:17-81:68 ("r the second date in DDMMY...) + Putting it back + Ok + Cutting chunk 43/120 @ 58:14-59:20 ("fference TO DayDifferenceP...) + Putting it back + Ok + Cutting chunk 92/120 @ 144:3-146:12 ("A DIVISION.\r\nWORKING-STO...) + Putting it back + Ok + Cutting chunk 98/120 @ 154:29-155:36 (" PIC XX.\r\n 02 YY...) + Putting it back + Ok + Cutting chunk 55/120 @ 79:7-81:17 ("dSecondDate.\r\n DISPLA...) + Putting it back + Ok + Cutting chunk 110/120 @ 176:49-179:3 ("cond\r\n* Date and the dif...) + Putting it back + Ok + Cutting chunk 62/120 @ 91:9-91:60 ("AY \"Invalid date . Return...) + Putting it back + Ok + Cutting chunk 71/120 @ 98:59-105:14 ("onth.\"\r\n END-EVALUAT...) + Putting it back + Ok +|}];; diff --git a/test/output-tests/dune b/test/output-tests/dune index afce6339a..c1af48308 100644 --- a/test/output-tests/dune +++ b/test/output-tests/dune @@ -3,7 +3,7 @@ (executable (name preproc) (modules Preproc) - (libraries cobol_preproc) + (libraries cobol_preproc testsuite_utils) ) (executable @@ -15,7 +15,13 @@ (executable (name reparse) (modules Reparse) - (libraries cobol_parser) + (libraries cobol_parser testsuite_utils) + ) + +(library + (name testsuite_utils) + (modules Testsuite_utils) + (libraries ez_file cobol_common cobol_config) ) (alias diff --git a/test/output-tests/preproc.ml b/test/output-tests/preproc.ml index 76201dee2..35ecced05 100644 --- a/test/output-tests/preproc.ml +++ b/test/output-tests/preproc.ml @@ -14,39 +14,14 @@ open Format 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 -> - find_dir "test" -let testsuites = "test/testsuite" -let ibm_testsuite = testsuites // "ibm/ibmmainframes.com" -let ibm_root = srcdir // ibm_testsuite -let mf_testsuite = testsuites // "microfocus/www.csis.ul.ie" -let mf_root = srcdir // mf_testsuite -;; - -module Diags = Cobol_common.Diagnostics.InitStateful () +open Testsuite_utils let preprocess_file ~source_format ~config = - preprocess_file ~ppf:std_formatter ~epf:std_formatter + Cobol_preproc.preprocess_file ~options:Cobol_preproc.Options.{ source_format; config; verbose = false; libpath = [] } - -let from_dialect = Cobol_config.from_dialect (module Diags) + ~ppf:std_formatter + ~epf:std_formatter let () = (* Print one token per line so we can diff outputs more easily. *) diff --git a/test/output-tests/reparse.ml b/test/output-tests/reparse.ml index 0e070fa84..d4043a09d 100644 --- a/test/output-tests/reparse.ml +++ b/test/output-tests/reparse.ml @@ -14,32 +14,7 @@ open Format 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 -> - find_dir "test" -let testsuites = "test/testsuite" -let ibm_testsuite = testsuites // "ibm/ibmmainframes.com" -let ibm_root = srcdir // ibm_testsuite -let mf_testsuite = testsuites // "microfocus/www.csis.ul.ie" -let mf_root = srcdir // mf_testsuite -;; - -module Diags = Cobol_common.Diagnostics.InitStateful () +open Testsuite_utils let reparse_file ~source_format ~config filename = let parse ~source_format input = @@ -74,8 +49,6 @@ let reparse_file ~source_format ~config filename = ) | _ | exception _ -> Format.printf "Parse: Failure." -let from_dialect = Cobol_config.from_dialect (module Diags) - let () = (* Print one token per line so we can diff outputs more easily. *) Pretty.pp_set_margin std_formatter 3; diff --git a/test/output-tests/testsuite_utils.ml b/test/output-tests/testsuite_utils.ml new file mode 100644 index 000000000..386f989ba --- /dev/null +++ b/test/output-tests/testsuite_utils.ml @@ -0,0 +1,49 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file +open FileString.OP + +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 -> find_dir "test" +let () = (* TODO: avoid relying on this var only in `Cobol_config` *) + Unix.putenv "COB_CONFIG_DIR" (srcdir // "import" // "gnucobol" // "config") + +let srcdir_marker = "__srcdir__" +let srcdir_regexp = Str.(regexp @@ quote srcdir) +let end_with_postproc s = + print_endline @@ Str.global_replace srcdir_regexp srcdir_marker s + +let testsuites = "test" // "testsuite" +let ibm_testsuite = testsuites // "ibm" // "ibmmainframes.com" +let ibm_root = srcdir // ibm_testsuite +let mf_testsuite = testsuites // "microfocus" // "www.csis.ul.ie" +let mf_root = srcdir // mf_testsuite + +module Diags = Cobol_common.Diagnostics.InitStateful () + +let from_dialect = Cobol_config.from_dialect (module Diags)