diff --git a/src/autofonce_core/parser.ml b/src/autofonce_core/parser.ml index 35e3b84..8617840 100644 --- a/src/autofonce_core/parser.ml +++ b/src/autofonce_core/parser.ml @@ -152,7 +152,7 @@ let load_file ~dirs ~keep_files ~path c filename = let s = { s with subst } in iter_state s macros - | Comment _ -> + | Comment _string -> iter_state s macros | Macro ( ( "AF_SETUP" | "AT_SETUP" ), [ name ]) -> @@ -170,6 +170,7 @@ let load_file ~dirs ~keep_files ~path c filename = test_banner = s.banner ; test_subst = s.subst ; test_keywords_set = StringSet.empty ; + test_regen = false ; } in let steps = ref [0] in diff --git a/src/autofonce_core/types.ml b/src/autofonce_core/types.ml index 9030b0d..ae13739 100644 --- a/src/autofonce_core/types.ml +++ b/src/autofonce_core/types.ml @@ -66,6 +66,7 @@ and test = { (* variable name is `t` *) test_banner : string ; test_env : string ; test_subst : string list ; + test_regen : bool ; mutable test_keywords : string list ; mutable test_actions : action list ; mutable test_keywords_set : StringSet.t ; diff --git a/src/autofonce_lib/command_gen.ml b/src/autofonce_lib/command_gen.ml index a5c4967..d70ebf0 100644 --- a/src/autofonce_lib/command_gen.ml +++ b/src/autofonce_lib/command_gen.ml @@ -10,6 +10,7 @@ (* *) (**************************************************************************) +(* open Ezcmd.V2 open EZCMD.TYPES open Ez_file.V1 @@ -174,3 +175,4 @@ let cmd = `P {|Generates a full testsuite in directory tests/ from a set of data files.|} ]; ] +*) diff --git a/src/autofonce_lib/command_promote.ml b/src/autofonce_lib/command_promote.ml index 5c1fea5..75dc458 100644 --- a/src/autofonce_lib/command_promote.ml +++ b/src/autofonce_lib/command_promote.ml @@ -67,7 +67,7 @@ let promote ~filter_args ~exec_args p tc suite = Promote.print_actions ~not_exit:!not_exit ~keep_old:false - b t.test_actions; + t b t.test_actions; let content = Buffer.contents b in Patch_lines.replace_block ~file ~line_first ~line_last content diff --git a/src/autofonce_lib/command_regen.ml b/src/autofonce_lib/command_regen.ml index 76fdfc4..f78e3ff 100644 --- a/src/autofonce_lib/command_regen.ml +++ b/src/autofonce_lib/command_regen.ml @@ -10,207 +10,138 @@ (* *) (**************************************************************************) -open EzCompat -(* open Ez_win32.V1 *) open Ezcmd.V2 -(* open EZCMD.TYPES *) -open Ez_file.V1 -(* open Ez_call.V1 *) -open Ez_subst.V2 +open EZCMD.TYPES -module Misc = Autofonce_misc.Misc +module Patch_lines = Autofonce_patch.Patch_lines module Parser = Autofonce_core.Parser +module Misc = Autofonce_misc.Misc +open Types +open Filter -let regen_file filename = - let lines = EzFile.read_lines filename in - let dirname = Filename.dirname filename in - let b = Buffer.create 10000 in - - let must_cleanup = ref false in - let topmap = ref StringMap.empty in - let map = ref StringMap.empty in - - let cleanup () = - if !must_cleanup then begin - Printf.bprintf b "\nAT_CLEANUP\n\n"; - must_cleanup := false ; - map := !topmap ; - end else begin - topmap := !map - end; - Printf.bprintf b - "\n\n\n#############################################################\n\n"; - in +(* TODO: check why the ignore pattern does not work *) +let diff args = Patch_lines.Diff { exclude = [ "^# promoted on .*" ]; args } +let todo = ref (diff None) +let not_exit = ref false - let unescape s = - let len = String.length s in - if len >=2 && s.[0] = '"' && s.[len-1] = '"' then - String.sub s 1 (len-2) - else s +let promote ~filter_args ~exec_args p tc suite = + filter_args.arg_only_failed <- true ; + Patch_lines.reset (); + let state = Runner_common.create_state ~exec_args p tc suite in + Unix.chdir state.state_run_dir ; + (* + let comment_line = + let t = Unix.gettimeofday () in + let tm = Unix.localtime t in + Printf.sprintf "# promoted on %04d-%02d-%02dT%02d:%02d" + ( 1900 + tm.tm_year ) + ( 1 + tm.tm_mon ) + tm.tm_mday + tm.tm_hour + tm.tm_min in +*) + let promote_test t = - let get lnum s = try - StringMap.find s !map - with Not_found -> - Misc.error "%s:%d: variable %S not found" filename lnum s - in - - let subst lnum s = - let brace lnum s = - let rec iter var cmds = - match cmds with - | [] -> var - | cmd :: cmds -> - let var = match cmd with - | "basename" -> Filename.remove_extension var - | "get" -> get lnum var - | "read" -> EzFile.read_file (Filename.concat dirname var) - | "read?" -> - let file = Filename.concat dirname var in - if Sys. file_exists file then EzFile.read_file file - else "" - | _ -> Misc.error "Subst: function %%{%s} not defined" cmd - in - iter var cmds - in - let s = String.lowercase_ascii s in - let list = List.rev @@ EzString.split s ':' in - match list with - | [] -> Misc.error "Subst: empty string" - | var :: "string" :: cmds -> iter var cmds - | var :: cmds -> - let var = - let maybe_not_found, var = - let len = String.length var in - if len > 0 && var.[0] = '?' then - true, String.sub var 1 (len-1) - else - false, var - in - try StringMap.find var !map with - | _ -> - if maybe_not_found then "" else - Misc.error "Subst: variable %%{%s} not defined" var - in - iter var cmds + let rec check actions = + match actions with + | [] -> false + | AF_COMMENT comment :: + AT_DATA _ :: + _ when EzString.starts_with comment ~prefix:"autofonce.read:" + -> true + | _ :: actions -> check actions in - EZ_SUBST.string ~ctxt: lnum ~sep:'%' ~brace s - in - let set name value = - map := StringMap.add name value !map - in - let rec reset value = - if StringMap.mem value !map then begin - map := StringMap.remove value !map; - reset value - end else - match StringMap.find value !topmap with - | exception Not_found -> () - | v -> - map := StringMap.add value v !map - in + if check t.test_actions then + let file = t.test_loc.file in + Printf.eprintf "Promoting test %d %s\n%!" + t.test_id ( Parser.name_of_loc t.test_loc ); + let line_first = t.test_loc.line in + let line_last = + match List.rev t.test_actions with + | AT_CLEANUP { loc } :: _ -> loc.line + | _ -> Misc.error + "Last test in %s does not end with AT_CLEANUP ?" file + in - set "num" ""; - set "exit" "0"; - set "stdout" ""; - set "stderr" ""; - - Array.iteri (fun lnum line -> - - let len = String.length line in - if len > 0 && line.[0] <> '#' then - let cmd, value = EzString.cut_at line ':' in - let value = String.trim value in - match cmd with - | "test" -> - cleanup (); - Printf.bprintf b "\n\nAT_SETUP(%s)\n" (Parser.m4_escape value); - must_cleanup := true - | "keywords" -> + let b = Buffer.create 10000 in + + Printf.bprintf b "AT_SETUP(%s)\n" (Parser.m4_escape t.test_name); + + begin + match t.test_keywords with + | [] -> () + | list -> Printf.bprintf b "AT_KEYWORDS(%s)\n\n" - (Parser.m4_escape (subst lnum value)) - | "reset" -> - let values = EzString.split value ',' in - List.iter reset values - | "set" -> - let name, value = EzString.cut_at value ':' in - let name = String.trim name in - let value = unescape @@ String.trim value in - set name value - | "comment" -> Printf.bprintf b "# %s\n" value - | "skip" -> Printf.bprintf b "%s" - ( String.make (try int_of_string value with _ -> 1) '\n' ) - | "data" -> - let file1, file2 = - let file1, file2 = EzString.cut_at value ':' in - let file2 = if file2 = "" then file1 else file2 in - file1, file2 - in - let basename = Filename.basename file1 in - let contents = EzFile.read_file (Filename.concat dirname file2) in - Printf.bprintf b "AT_DATA(%s,%s)\n" - (Parser.m4_escape basename) - (Parser.m4_escape contents); - | "target" -> - let file1, file2 = - let file1, file2 = EzString.cut_at value ':' in - let file2 = if file2 = "" then file1 else file2 in - file1, file2 - in - let basename = Filename.basename file1 in - let contents = EzFile.read_file (Filename.concat dirname file2) in - Printf.bprintf b "AT_DATA(%s,%s)\n" - (Parser.m4_escape basename) - (Parser.m4_escape contents); - set "target" basename - | "check" -> - set "check" value ; - let command = subst lnum @@ get lnum value in - let exit = subst lnum @@ get lnum "exit" in - let stdout = subst lnum @@ get lnum "stdout" in - let stderr = subst lnum @@ get lnum "stderr" in - Printf.bprintf b "\nAT_CHECK(%s, %s, %s, %s)\n" - (Parser.m4_escape command) - (Parser.m4_escape exit) - (Parser.m4_escape stdout) - (Parser.m4_escape stderr) - | "save" -> - - cleanup (); - let output = Filename.concat dirname value in - let new_contents = Buffer.contents b in - Buffer.clear b; - let old_contents = try EzFile.read_file output with _ -> "" in - if new_contents <> old_contents then begin - EzFile.write_file output new_contents; - Printf.eprintf "File %S regenerated\n%!" output - end - | _ -> Misc.error "Unknown command %S" cmd - ) lines - -let regen () = - let rec iter dirname = - let files = Sys.readdir dirname in - Array.iter (fun basename -> - let filename = Filename.concat dirname basename in - if try Sys.is_directory filename with _ -> false then - iter filename - else - let ext = Filename.extension basename in - if ext = ".atscript" then - regen_file filename - ) files + (Parser.m4_escape (String.concat " " list)) + end; + Promote.print_actions + ~not_exit:!not_exit + ~keep_old:true + t b t.test_actions; + + let content = Buffer.contents b in + Patch_lines.replace_block ~file ~line_first ~line_last content in - iter "." + List.iter promote_test suite.suite_tests; + Patch_lines.commit_to_disk ~action:!todo (); + () + +let args auto_promote_arg ~exec_args = [ + + [ "not-exit" ], Arg.Set not_exit, + EZCMD.info "Do not promote exit code" ; + + [ "diff-args" ], Arg.String (fun s -> todo := diff (Some s)), + EZCMD.info ~docv:"ARGS" "Pass these args to the diff command" ; + + [ auto_promote_arg ], Arg.Int (fun n -> + exec_args.arg_auto_promote <- n ; + todo := Apply ; + ), + EZCMD.info + "Promote and run until all tests have been promoted" + +] + +let action ~filter_args ~exec_args p tc suite = + promote ~filter_args ~exec_args p tc suite let cmd = - let args = [] in - EZCMD.sub "regen" regen + let testsuite_args, get_testsuite_args = Testsuite.args () in + let filter_args, get_filter_args = Filter.args () in + let runner_args, exec_args = Runner_common.args () in + let args = + runner_args @ + testsuite_args @ + filter_args @ + args ~exec_args "auto-run" @ + [ + + [ "apply" ], Arg.Unit (fun () -> todo := Apply), + EZCMD.info "Apply promotion (default is to diff)" ; + + [ "diff" ], Arg.Unit (fun () -> todo := diff None), + EZCMD.info "Diff promotion (default)" ; + + [ "fake" ], Arg.String (fun ext -> todo := Fake ext), + EZCMD.info ~docv:".EXT" + "Apply promotion to create new files with extension $(docv)" ; + + ] + in + EZCMD.sub + "regen" + (fun () -> + let filter_args = get_filter_args () in + let p, tc, suite = Testsuite.find ( get_testsuite_args () ) in + action ~filter_args ~exec_args p tc suite + ) ~args - ~doc: "Generate a testsuite" + ~doc: "Regen tests from templates" ~man:[ `S "DESCRIPTION"; `Blocks [ - `P {|Generates a full testsuite in directory tests/ from a set of data files.|} + `P {|.|} ; ]; ] diff --git a/src/autofonce_lib/logging.ml b/src/autofonce_lib/logging.ml index 2d8b1c4..08aa156 100644 --- a/src/autofonce_lib/logging.ml +++ b/src/autofonce_lib/logging.ml @@ -187,7 +187,7 @@ let log_failed_tests state msg tests = Promote.print_actions ~not_exit:false ~keep_old:true - b1 t.test_actions ; + t b1 t.test_actions ; let s1 = Buffer.contents b1 in let f1 = test_dir // "test.at.expected" in EzFile.write_file f1 s1; @@ -196,7 +196,7 @@ let log_failed_tests state msg tests = Promote.print_actions ~not_exit:false ~keep_old:false - b2 t.test_actions ; + t b2 t.test_actions ; let s2 = Buffer.contents b2 in let f2 = test_dir // "test.at.promoted" in EzFile.write_file f2 s2; diff --git a/src/autofonce_lib/main.ml b/src/autofonce_lib/main.ml index 3455eb7..bda81cd 100644 --- a/src/autofonce_lib/main.ml +++ b/src/autofonce_lib/main.ml @@ -43,7 +43,6 @@ let commands = [ Command_config.cmd ; Command_run.cmd ; Command_new.cmd ; - Command_gen.cmd ; Command_regen.cmd ; Command_promote.cmd ; ] diff --git a/src/autofonce_lib/promote.ml b/src/autofonce_lib/promote.ml index 3faa45a..be1883d 100644 --- a/src/autofonce_lib/promote.ml +++ b/src/autofonce_lib/promote.ml @@ -10,6 +10,7 @@ (* *) (**************************************************************************) +open EzCompat open Ez_file.V1 open EzFile.OP @@ -28,7 +29,7 @@ open Types *) -let print_actions ~not_exit ~keep_old b actions = +let print_actions t ~not_exit ~keep_old b actions = let rec string_of_check check = let b = Buffer.create 1000 in Buffer.add_string b "AT_CHECK("; @@ -243,7 +244,24 @@ let print_actions ~not_exit ~keep_old b actions = Printf.bprintf b "\n#%s\n" comment and print_actions b actions = - List.iter ( print_action b ) actions + match actions with + [] -> () + | AF_COMMENT comment :: + AT_DATA { file ; content } :: + actions -> + let content = + match EzString.chop_prefix ~prefix:"autofonce.read:" comment with + | None -> content + | Some filename -> + let dirname = Filename.dirname t.test_loc.file in + EzFile.read_file (Filename.concat dirname filename) + in + print_action b (AF_COMMENT comment); + print_action b (AT_DATA { file ; content }); + print_actions b actions + | action :: actions -> + print_action b action ; + print_actions b actions in print_actions b actions diff --git a/src/autofonce_lib/promote.mli b/src/autofonce_lib/promote.mli index 125a49c..089f9dc 100644 --- a/src/autofonce_lib/promote.mli +++ b/src/autofonce_lib/promote.mli @@ -11,6 +11,7 @@ (**************************************************************************) val print_actions : + Types.test -> not_exit:bool -> keep_old:bool -> Buffer.t -> Types.action list -> unit