Skip to content

Commit

Permalink
Merge pull request #37 from lefessan/z-2023-10-13-fixes
Browse files Browse the repository at this point in the history 
Escape parens and fix promotion
  • Loading branch information
@lefessan
lefessan authored Dec 18, 2023
2 parents 7f20bc0 + 727eb89 commit d86ccbb
Show file tree
Hide file tree
Showing 4 changed files with 142 additions and 81 deletions.
1 change: 1 addition & 0 deletions CHANGES.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
101 changes: 74 additions & 27 deletions src/autofonce_core/parser.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -536,32 +536,79 @@ let read ?(path=[]) filename =
c.suite_tests <- List.rev c.suite_tests ;
c

let m4_escape s =
let b = Buffer.create (String.length s) in
Buffer.add_char b '[';
let rec iter was_space b s pos len =
if pos < len then
let m4_escape ?(can_quote=true) s =
let len = String.length s in

(* Find for each position if a matching closing par is available *)
let pars = Array.make len 0 in
let rec iter ~npars ~nbras ~has_quote ~has_impaired ~pos =
if pos > 0 then
let pos = pos - 1 in
let c = s.[pos] in
let pos = pos+1 in
match c with
| '[' ->
Buffer.add_string b "@<:@";
iter false b s pos len
| ']' ->
Buffer.add_string b "@:>@";
iter false b s pos len
| ' ' | '\t' | '\012' ->
Buffer.add_char b c;
iter true b s pos len;
| '\n' ->
if was_space then
Buffer.add_string b "@&t@";
Buffer.add_char b c;
iter false b s pos len;
| c ->
Buffer.add_char b c;
iter false b s pos len;

pars.(pos) <- npars;
let npars =
match c with
| '(' -> if npars > 0 then npars-1 else 0
| ')' -> npars+1
| _ -> npars
in

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 false b s 0 ( String.length s );
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
3 changes: 2 additions & 1 deletion src/autofonce_core/parser.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
118 changes: 65 additions & 53 deletions src/autofonce_lib/promote.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]"
Expand All @@ -66,33 +111,17 @@ 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;

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
match check.check_stderr with
| Content "" -> ()
| Ignore -> ()
| _ ->
Printf.bprintf b ", []"
else
Expand All @@ -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]"
Expand Down Expand Up @@ -234,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
Expand Down

0 comments on commit d86ccbb

Please sign in to comment.