From 853931f372db4aa6c04683c2c4fa0a3e86cf2331 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Fri, 13 Oct 2023 14:49:02 +0200 Subject: [PATCH 1/2] Escape parens and fix promotion --- CHANGES.md | 1 + src/autofonce_core/parser.ml | 47 ++++++++++++++++++++++++++++++------ src/autofonce_lib/promote.ml | 5 ++-- 3 files changed, 42 insertions(+), 11 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ce90bb0..522655d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ * add ~force_source_dir and ~force_build_dir to Project_config.from_file * Improved compatibility with Autoconf: * Discard spaces at end of lines, unless @&t@ is used as last space + * Escape parens, do not escape them if they match each other * add support for [stdout], [stderr], [expout] and [experr] * Add file basename to test keywords, so that it is possible to use it as a keyword to select all the test of a file diff --git a/src/autofonce_core/parser.ml b/src/autofonce_core/parser.ml index 0c0207a..f5b189b 100644 --- a/src/autofonce_core/parser.ml +++ b/src/autofonce_core/parser.ml @@ -537,31 +537,62 @@ let read ?(path=[]) filename = c let m4_escape s = - let b = Buffer.create (String.length s) in + let len = String.length s in + let b = Buffer.create len in + + (* Find for each position if a matching closing par is available *) + let pars = Array.make len 0 in + let rec iter n pars s pos len = + if pos > 0 then + let pos = pos - 1 in + let c = s.[pos] in + pars.(pos) <- n; + let n = + match c with + | '(' -> if n > 0 then n-1 else 0 + | ')' -> n+1 + | _ -> n + in + iter n pars s pos len + in + iter 0 pars s len len; + Buffer.add_char b '['; - let rec iter was_space b s pos len = + let rec iter pos was_space npars = if pos < len then let c = s.[pos] in let pos = pos+1 in match c with | '[' -> Buffer.add_string b "@<:@"; - iter false b s pos len + iter pos false npars | ']' -> Buffer.add_string b "@:>@"; - iter false b s pos len + iter pos false npars + | '(' -> + Buffer.add_string b ( + if pars.(pos-1) = 0 then + "@{:@" + else + "(" + ); + iter pos false (npars+1) + | ')' -> + Buffer.add_string b (if npars>0 then ")" else "@:}@"); + let npars = if npars>0 then npars-1 else 0 in + iter pos false npars | ' ' | '\t' | '\012' -> Buffer.add_char b c; - iter true b s pos len; + iter pos true npars; | '\n' -> if was_space then Buffer.add_string b "@&t@"; Buffer.add_char b c; - iter false b s pos len; + iter pos false npars; | c -> Buffer.add_char b c; - iter false b s pos len; + iter pos false npars; in - iter false b s 0 ( String.length s ); + iter 0 false 0 ; Buffer.add_char b ']'; Buffer.contents b diff --git a/src/autofonce_lib/promote.ml b/src/autofonce_lib/promote.ml index 1718f2b..1925185 100644 --- a/src/autofonce_lib/promote.ml +++ b/src/autofonce_lib/promote.ml @@ -66,7 +66,7 @@ let print_actions ~not_exit ~keep_old b actions = Printf.bprintf b ", [%d]" retcode else match check.check_stdout, check.check_stderr with - | Content "", Content "" -> () + | Ignore, Ignore -> () | _ -> Printf.bprintf b ", [%d]" retcode; end; @@ -92,7 +92,7 @@ let print_actions ~not_exit ~keep_old b actions = | Content content -> if content = "" then match check.check_stderr with - | Content "" -> () + | Ignore -> () | _ -> Printf.bprintf b ", []" else @@ -138,7 +138,6 @@ let print_actions ~not_exit ~keep_old b actions = | Diff_with_file file -> assert (file = "expout" || file = "experr"); Printf.bprintf b ", [%s]" file - | Content "" -> () | Content content -> let s = Parser.m4_escape content in if Buffer.length b + String.length s > 80 then From 727eb8900cef627ed637bf4e7a99014ef107e517 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Fri, 20 Oct 2023 00:08:07 +0200 Subject: [PATCH 2/2] Use quoting instead of escaping when possible in promotions --- src/autofonce_core/parser.ml | 114 ++++++++++++++++++--------------- src/autofonce_core/parser.mli | 3 +- src/autofonce_lib/promote.ml | 115 +++++++++++++++++++--------------- 3 files changed, 131 insertions(+), 101 deletions(-) diff --git a/src/autofonce_core/parser.ml b/src/autofonce_core/parser.ml index f5b189b..35e3b84 100644 --- a/src/autofonce_core/parser.ml +++ b/src/autofonce_core/parser.ml @@ -536,63 +536,79 @@ let read ?(path=[]) filename = c.suite_tests <- List.rev c.suite_tests ; c -let m4_escape s = +let m4_escape ?(can_quote=true) s = let len = String.length s in - let b = Buffer.create len in (* Find for each position if a matching closing par is available *) let pars = Array.make len 0 in - let rec iter n pars s pos len = + let rec iter ~npars ~nbras ~has_quote ~has_impaired ~pos = if pos > 0 then let pos = pos - 1 in let c = s.[pos] in - pars.(pos) <- n; - let n = + + pars.(pos) <- npars; + let npars = match c with - | '(' -> if n > 0 then n-1 else 0 - | ')' -> n+1 - | _ -> n + | '(' -> if npars > 0 then npars-1 else 0 + | ')' -> npars+1 + | _ -> npars in - iter n pars s pos len - in - iter 0 pars s len len; - Buffer.add_char b '['; - let rec iter pos was_space npars = - if pos < len then - let c = s.[pos] in - let pos = pos+1 in - match c with - | '[' -> - Buffer.add_string b "@<:@"; - iter pos false npars - | ']' -> - Buffer.add_string b "@:>@"; - iter pos false npars - | '(' -> - Buffer.add_string b ( - if pars.(pos-1) = 0 then - "@{:@" - else - "(" - ); - iter pos false (npars+1) - | ')' -> - Buffer.add_string b (if npars>0 then ")" else "@:}@"); - let npars = if npars>0 then npars-1 else 0 in - iter pos false npars - | ' ' | '\t' | '\012' -> - Buffer.add_char b c; - iter pos true npars; - | '\n' -> - if was_space then - Buffer.add_string b "@&t@"; - Buffer.add_char b c; - iter pos false npars; - | c -> - Buffer.add_char b c; - iter pos false npars; + let nbras = match c with + | '[' -> nbras-1 + | ']' -> nbras+1 + | _ -> nbras + in + let has_quote = has_quote || nbras > 0 in + let has_impaired = has_impaired || nbras < 0 in + iter ~npars ~nbras ~has_quote ~has_impaired ~pos + else + let has_impaired = has_impaired || nbras > 0 in + has_quote && not has_impaired in - iter 0 false 0 ; - Buffer.add_char b ']'; - Buffer.contents b + let should_quote = iter ~npars:0 ~nbras:0 + ~has_quote:false + ~has_impaired:false ~pos:len in + if can_quote && should_quote then + Printf.sprintf "[[%s]]" s + else + let b = Buffer.create len in + Buffer.add_char b '['; + let rec iter pos was_space npars = + if pos < len then + let c = s.[pos] in + let pos = pos+1 in + match c with + | '[' -> + Buffer.add_string b "@<:@"; + iter pos false npars + | ']' -> + Buffer.add_string b "@:>@"; + iter pos false npars + | '(' -> + Buffer.add_string b ( + if pars.(pos-1) = 0 then + "@{:@" + else + "(" + ); + iter pos false (npars+1) + | ')' -> + Buffer.add_string b (if npars>0 then ")" else "@:}@"); + let npars = if npars>0 then npars-1 else 0 in + iter pos false npars + | ' ' | '\t' | '\012' -> + Buffer.add_char b c; + iter pos true npars; + | '\n' -> + if was_space then + Buffer.add_string b "@&t@"; + Buffer.add_char b c; + iter pos false npars; + | c -> + Buffer.add_char b c; + iter pos false npars; + in + iter 0 false 0 ; + Buffer.add_char b ']'; + Buffer.contents b diff --git a/src/autofonce_core/parser.mli b/src/autofonce_core/parser.mli index 6336fbc..cceaa9c 100644 --- a/src/autofonce_core/parser.mli +++ b/src/autofonce_core/parser.mli @@ -11,7 +11,8 @@ (**************************************************************************) val name_of_loc : Types.location -> string -val m4_escape : string -> string + +val m4_escape : ?can_quote:bool -> string -> string (* Read filename to get the corresponding testsuite *) val read : ?path:string list -> string -> Types.suite diff --git a/src/autofonce_lib/promote.ml b/src/autofonce_lib/promote.ml index 1925185..139a63b 100644 --- a/src/autofonce_lib/promote.ml +++ b/src/autofonce_lib/promote.ml @@ -39,25 +39,70 @@ let print_actions ~not_exit ~keep_old b actions = run-if-pass or run-if-fail is not empty. Otherwise, the check must pass after promotion. *) + if check.check_run_if_pass = [] && check.check_run_if_fail = [] then begin + (* We can promote these results *) + + let retcode = + if not_exit || keep_old then check.check_retcode + else + match check.check_retcode with + | None -> None + | Some old_retcode -> + let check_exit = Printf.sprintf "%s.exit" check_prefix in + if Sys.file_exists check_exit then + let s = EzFile.read_file check_exit in + let retcode = int_of_string s in + Some retcode + else + Some old_retcode + in - begin - let retcode = - if not_exit || keep_old then check.check_retcode - else - match check.check_retcode with - | None -> None - | Some old_retcode -> - let check_exit = Printf.sprintf "%s.exit" check_prefix in - if Sys.file_exists check_exit then - let s = EzFile.read_file check_exit in - let retcode = int_of_string s in - Some retcode - else - Some old_retcode - in + let stdout = + if keep_old then check.check_stdout else + match check.check_stdout with + | Ignore -> Ignore + | Content old_content -> + let check_stdout = + Printf.sprintf "%s.out.subst" check_prefix in + if Sys.file_exists check_stdout then + let s = EzFile.read_file check_stdout in + Content s + else + Content old_content + | Save_to_file _ + | Diff_with_file _ + -> check.check_stdout + in + + let stderr = + if keep_old then check.check_stderr else + match check.check_stderr with + | Ignore -> Ignore + | Content old_content -> + let check_stderr = + Printf.sprintf "%s.err.subst" check_prefix in + if Sys.file_exists check_stderr then + let s = EzFile.read_file check_stderr in + Content s + else + Content old_content + | Save_to_file _ + | Diff_with_file _ + -> check.check_stdout + in + + let nargs = + match retcode, stdout, stderr with + | Some 0, Content "", Content "" -> 0 + | _, Content "", Content "" -> 1 + | _, _, Content "" -> 2 + | _ -> 3 + in + + if nargs > 0 then begin match retcode with | None -> Printf.bprintf b ", [ignore]" @@ -71,23 +116,7 @@ let print_actions ~not_exit ~keep_old b actions = Printf.bprintf b ", [%d]" retcode; end; - begin - let stdout = - if keep_old then check.check_stdout else - match check.check_stdout with - | Ignore -> Ignore - | Content old_content -> - let check_stdout = - Printf.sprintf "%s.out.subst" check_prefix in - if Sys.file_exists check_stdout then - let s = EzFile.read_file check_stdout in - Content s - else - Content old_content - | Save_to_file _ - | Diff_with_file _ - -> check.check_stdout - in + if nargs > 1 then begin match stdout with | Content content -> if content = "" then @@ -109,26 +138,9 @@ let print_actions ~not_exit ~keep_old b actions = Printf.bprintf b ", [%s]" file | Ignore -> Printf.bprintf b ", [ignore]" - end; - begin - let stderr = - if keep_old then check.check_stderr else - match check.check_stderr with - | Ignore -> Ignore - | Content old_content -> - let check_stderr = - Printf.sprintf "%s.err.subst" check_prefix in - if Sys.file_exists check_stderr then - let s = EzFile.read_file check_stderr in - Content s - else - Content old_content - | Save_to_file _ - | Diff_with_file _ - -> check.check_stdout - in + if nargs > 2 then begin match stderr with | Ignore -> Printf.bprintf b ", [ignore]" @@ -138,6 +150,7 @@ let print_actions ~not_exit ~keep_old b actions = | Diff_with_file file -> assert (file = "expout" || file = "experr"); Printf.bprintf b ", [%s]" file + | Content "" -> () | Content content -> let s = Parser.m4_escape content in if Buffer.length b + String.length s > 80 then @@ -233,7 +246,7 @@ let print_actions ~not_exit ~keep_old b actions = | AT_CHECK check -> Printf.bprintf b "\n%s\n" ( string_of_check check ) | AF_COMMENT comment -> - Printf.bprintf b "#%s\n\n" comment + Printf.bprintf b "\n#%s\n" comment and print_actions b actions = List.iter ( print_action b ) actions