Skip to content

Commit 0dd3657

Browse files
lefessanlefessan
authored
Merge pull request #41 from lefessan/z-2026-03-16-regen
autofonce regen: use comment autofonce.read: before AT_DATA
2 parents feb7097 + b7d2f4f commit 0dd3657

File tree

9 files changed

+145
-192
lines changed

9 files changed

+145
-192
lines changed

‎src/autofonce_core/parser.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ let load_file ~dirs ~keep_files ~path c filename =
152152
let s = { s with subst } in
153153
iter_state s macros
154154

155-
| Comment _ ->
155+
| Comment _string ->
156156
iter_state s macros
157157

158158
| Macro ( ( "AF_SETUP" | "AT_SETUP" ), [ name ]) ->
@@ -170,6 +170,7 @@ let load_file ~dirs ~keep_files ~path c filename =
170170
test_banner = s.banner ;
171171
test_subst = s.subst ;
172172
test_keywords_set = StringSet.empty ;
173+
test_regen = false ;
173174
}
174175
in
175176
let steps = ref [0] in

‎src/autofonce_core/types.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ and test = { (* variable name is `t` *)
6666
test_banner : string ;
6767
test_env : string ;
6868
test_subst : string list ;
69+
test_regen : bool ;
6970
mutable test_keywords : string list ;
7071
mutable test_actions : action list ;
7172
mutable test_keywords_set : StringSet.t ;

‎src/autofonce_lib/command_gen.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@
1010
(* *)
1111
(**************************************************************************)
1212

13+
(*
1314
open Ezcmd.V2
1415
open EZCMD.TYPES
1516
open Ez_file.V1
@@ -174,3 +175,4 @@ let cmd =
174175
`P {|Generates a full testsuite in directory tests/ from a set of data files.|}
175176
];
176177
]
178+
*)

‎src/autofonce_lib/command_promote.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ let promote ~filter_args ~exec_args p tc suite =
6767
Promote.print_actions
6868
~not_exit:!not_exit
6969
~keep_old:false
70-
b t.test_actions;
70+
t b t.test_actions;
7171

7272
let content = Buffer.contents b in
7373
Patch_lines.replace_block ~file ~line_first ~line_last content

‎src/autofonce_lib/command_regen.ml‎

Lines changed: 116 additions & 185 deletions
Original file line numberDiff line numberDiff line change
@@ -10,207 +10,138 @@
1010
(* *)
1111
(**************************************************************************)
1212

13-
open EzCompat
14-
(* open Ez_win32.V1 *)
1513
open Ezcmd.V2
16-
(* open EZCMD.TYPES *)
17-
open Ez_file.V1
18-
(* open Ez_call.V1 *)
19-
open Ez_subst.V2
14+
open EZCMD.TYPES
2015

21-
module Misc = Autofonce_misc.Misc
16+
module Patch_lines = Autofonce_patch.Patch_lines
2217
module Parser = Autofonce_core.Parser
18+
module Misc = Autofonce_misc.Misc
19+
open Types
20+
open Filter
2321

24-
let regen_file filename =
25-
let lines = EzFile.read_lines filename in
26-
let dirname = Filename.dirname filename in
27-
let b = Buffer.create 10000 in
28-
29-
let must_cleanup = ref false in
30-
let topmap = ref StringMap.empty in
31-
let map = ref StringMap.empty in
32-
33-
let cleanup () =
34-
if !must_cleanup then begin
35-
Printf.bprintf b "\nAT_CLEANUP\n\n";
36-
must_cleanup := false ;
37-
map := !topmap ;
38-
end else begin
39-
topmap := !map
40-
end;
41-
Printf.bprintf b
42-
"\n\n\n#############################################################\n\n";
43-
in
22+
(* TODO: check why the ignore pattern does not work *)
23+
let diff args = Patch_lines.Diff { exclude = [ "^# promoted on .*" ]; args }
24+
let todo = ref (diff None)
25+
let not_exit = ref false
4426

45-
let unescape s =
46-
let len = String.length s in
47-
if len >=2 && s.[0] = '"' && s.[len-1] = '"' then
48-
String.sub s 1 (len-2)
49-
else s
27+
let promote ~filter_args ~exec_args p tc suite =
28+
filter_args.arg_only_failed <- true ;
29+
Patch_lines.reset ();
30+
let state = Runner_common.create_state ~exec_args p tc suite in
31+
Unix.chdir state.state_run_dir ;
32+
(*
33+
let comment_line =
34+
let t = Unix.gettimeofday () in
35+
let tm = Unix.localtime t in
36+
Printf.sprintf "# promoted on %04d-%02d-%02dT%02d:%02d"
37+
( 1900 + tm.tm_year )
38+
( 1 + tm.tm_mon )
39+
tm.tm_mday
40+
tm.tm_hour
41+
tm.tm_min
5042
in
43+
*)
44+
let promote_test t =
5145

52-
let get lnum s = try
53-
StringMap.find s !map
54-
with Not_found ->
55-
Misc.error "%s:%d: variable %S not found" filename lnum s
56-
in
57-
58-
let subst lnum s =
59-
let brace lnum s =
60-
let rec iter var cmds =
61-
match cmds with
62-
| [] -> var
63-
| cmd :: cmds ->
64-
let var = match cmd with
65-
| "basename" -> Filename.remove_extension var
66-
| "get" -> get lnum var
67-
| "read" -> EzFile.read_file (Filename.concat dirname var)
68-
| "read?" ->
69-
let file = Filename.concat dirname var in
70-
if Sys. file_exists file then EzFile.read_file file
71-
else ""
72-
| _ -> Misc.error "Subst: function %%{%s} not defined" cmd
73-
in
74-
iter var cmds
75-
in
76-
let s = String.lowercase_ascii s in
77-
let list = List.rev @@ EzString.split s ':' in
78-
match list with
79-
| [] -> Misc.error "Subst: empty string"
80-
| var :: "string" :: cmds -> iter var cmds
81-
| var :: cmds ->
82-
let var =
83-
let maybe_not_found, var =
84-
let len = String.length var in
85-
if len > 0 && var.[0] = '?' then
86-
true, String.sub var 1 (len-1)
87-
else
88-
false, var
89-
in
90-
try StringMap.find var !map with
91-
| _ ->
92-
if maybe_not_found then "" else
93-
Misc.error "Subst: variable %%{%s} not defined" var
94-
in
95-
iter var cmds
46+
let rec check actions =
47+
match actions with
48+
| [] -> false
49+
| AF_COMMENT comment ::
50+
AT_DATA _ ::
51+
_ when EzString.starts_with comment ~prefix:"autofonce.read:"
52+
-> true
53+
| _ :: actions -> check actions
9654
in
97-
EZ_SUBST.string ~ctxt: lnum ~sep:'%' ~brace s
98-
in
99-
let set name value =
100-
map := StringMap.add name value !map
101-
in
102-
let rec reset value =
103-
if StringMap.mem value !map then begin
104-
map := StringMap.remove value !map;
105-
reset value
106-
end else
107-
match StringMap.find value !topmap with
108-
| exception Not_found -> ()
109-
| v ->
110-
map := StringMap.add value v !map
111-
in
55+
if check t.test_actions then
56+
let file = t.test_loc.file in
57+
Printf.eprintf "Promoting test %d %s\n%!"
58+
t.test_id ( Parser.name_of_loc t.test_loc );
59+
let line_first = t.test_loc.line in
60+
let line_last =
61+
match List.rev t.test_actions with
62+
| AT_CLEANUP { loc } :: _ -> loc.line
63+
| _ -> Misc.error
64+
"Last test in %s does not end with AT_CLEANUP ?" file
65+
in
11266

113-
set "num" "";
114-
set "exit" "0";
115-
set "stdout" "";
116-
set "stderr" "";
117-
118-
Array.iteri (fun lnum line ->
119-
120-
let len = String.length line in
121-
if len > 0 && line.[0] <> '#' then
122-
let cmd, value = EzString.cut_at line ':' in
123-
let value = String.trim value in
124-
match cmd with
125-
| "test" ->
126-
cleanup ();
127-
Printf.bprintf b "\n\nAT_SETUP(%s)\n" (Parser.m4_escape value);
128-
must_cleanup := true
129-
| "keywords" ->
67+
let b = Buffer.create 10000 in
68+
69+
Printf.bprintf b "AT_SETUP(%s)\n" (Parser.m4_escape t.test_name);
70+
71+
begin
72+
match t.test_keywords with
73+
| [] -> ()
74+
| list ->
13075
Printf.bprintf b "AT_KEYWORDS(%s)\n\n"
131-
(Parser.m4_escape (subst lnum value))
132-
| "reset" ->
133-
let values = EzString.split value ',' in
134-
List.iter reset values
135-
| "set" ->
136-
let name, value = EzString.cut_at value ':' in
137-
let name = String.trim name in
138-
let value = unescape @@ String.trim value in
139-
set name value
140-
| "comment" -> Printf.bprintf b "# %s\n" value
141-
| "skip" -> Printf.bprintf b "%s"
142-
( String.make (try int_of_string value with _ -> 1) '\n' )
143-
| "data" ->
144-
let file1, file2 =
145-
let file1, file2 = EzString.cut_at value ':' in
146-
let file2 = if file2 = "" then file1 else file2 in
147-
file1, file2
148-
in
149-
let basename = Filename.basename file1 in
150-
let contents = EzFile.read_file (Filename.concat dirname file2) in
151-
Printf.bprintf b "AT_DATA(%s,%s)\n"
152-
(Parser.m4_escape basename)
153-
(Parser.m4_escape contents);
154-
| "target" ->
155-
let file1, file2 =
156-
let file1, file2 = EzString.cut_at value ':' in
157-
let file2 = if file2 = "" then file1 else file2 in
158-
file1, file2
159-
in
160-
let basename = Filename.basename file1 in
161-
let contents = EzFile.read_file (Filename.concat dirname file2) in
162-
Printf.bprintf b "AT_DATA(%s,%s)\n"
163-
(Parser.m4_escape basename)
164-
(Parser.m4_escape contents);
165-
set "target" basename
166-
| "check" ->
167-
set "check" value ;
168-
let command = subst lnum @@ get lnum value in
169-
let exit = subst lnum @@ get lnum "exit" in
170-
let stdout = subst lnum @@ get lnum "stdout" in
171-
let stderr = subst lnum @@ get lnum "stderr" in
172-
Printf.bprintf b "\nAT_CHECK(%s, %s, %s, %s)\n"
173-
(Parser.m4_escape command)
174-
(Parser.m4_escape exit)
175-
(Parser.m4_escape stdout)
176-
(Parser.m4_escape stderr)
177-
| "save" ->
178-
179-
cleanup ();
180-
let output = Filename.concat dirname value in
181-
let new_contents = Buffer.contents b in
182-
Buffer.clear b;
183-
let old_contents = try EzFile.read_file output with _ -> "" in
184-
if new_contents <> old_contents then begin
185-
EzFile.write_file output new_contents;
186-
Printf.eprintf "File %S regenerated\n%!" output
187-
end
188-
| _ -> Misc.error "Unknown command %S" cmd
189-
) lines
190-
191-
let regen () =
192-
let rec iter dirname =
193-
let files = Sys.readdir dirname in
194-
Array.iter (fun basename ->
195-
let filename = Filename.concat dirname basename in
196-
if try Sys.is_directory filename with _ -> false then
197-
iter filename
198-
else
199-
let ext = Filename.extension basename in
200-
if ext = ".atscript" then
201-
regen_file filename
202-
) files
76+
(Parser.m4_escape (String.concat " " list))
77+
end;
78+
Promote.print_actions
79+
~not_exit:!not_exit
80+
~keep_old:true
81+
t b t.test_actions;
82+
83+
let content = Buffer.contents b in
84+
Patch_lines.replace_block ~file ~line_first ~line_last content
20385
in
204-
iter "."
86+
List.iter promote_test suite.suite_tests;
87+
Patch_lines.commit_to_disk ~action:!todo ();
88+
()
89+
90+
let args auto_promote_arg ~exec_args = [
91+
92+
[ "not-exit" ], Arg.Set not_exit,
93+
EZCMD.info "Do not promote exit code" ;
94+
95+
[ "diff-args" ], Arg.String (fun s -> todo := diff (Some s)),
96+
EZCMD.info ~docv:"ARGS" "Pass these args to the diff command" ;
97+
98+
[ auto_promote_arg ], Arg.Int (fun n ->
99+
exec_args.arg_auto_promote <- n ;
100+
todo := Apply ;
101+
),
102+
EZCMD.info
103+
"Promote and run until all tests have been promoted"
104+
105+
]
106+
107+
let action ~filter_args ~exec_args p tc suite =
108+
promote ~filter_args ~exec_args p tc suite
205109

206110
let cmd =
207-
let args = [] in
208-
EZCMD.sub "regen" regen
111+
let testsuite_args, get_testsuite_args = Testsuite.args () in
112+
let filter_args, get_filter_args = Filter.args () in
113+
let runner_args, exec_args = Runner_common.args () in
114+
let args =
115+
runner_args @
116+
testsuite_args @
117+
filter_args @
118+
args ~exec_args "auto-run" @
119+
[
120+
121+
[ "apply" ], Arg.Unit (fun () -> todo := Apply),
122+
EZCMD.info "Apply promotion (default is to diff)" ;
123+
124+
[ "diff" ], Arg.Unit (fun () -> todo := diff None),
125+
EZCMD.info "Diff promotion (default)" ;
126+
127+
[ "fake" ], Arg.String (fun ext -> todo := Fake ext),
128+
EZCMD.info ~docv:".EXT"
129+
"Apply promotion to create new files with extension $(docv)" ;
130+
131+
]
132+
in
133+
EZCMD.sub
134+
"regen"
135+
(fun () ->
136+
let filter_args = get_filter_args () in
137+
let p, tc, suite = Testsuite.find ( get_testsuite_args () ) in
138+
action ~filter_args ~exec_args p tc suite
139+
)
209140
~args
210-
~doc: "Generate a testsuite"
141+
~doc: "Regen tests from templates"
211142
~man:[
212143
`S "DESCRIPTION";
213144
`Blocks [
214-
`P {|Generates a full testsuite in directory tests/ from a set of data files.|}
145+
`P {|.|} ;
215146
];
216147
]

‎src/autofonce_lib/logging.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -187,7 +187,7 @@ let log_failed_tests state msg tests =
187187
Promote.print_actions
188188
~not_exit:false
189189
~keep_old:true
190-
b1 t.test_actions ;
190+
t b1 t.test_actions ;
191191
let s1 = Buffer.contents b1 in
192192
let f1 = test_dir // "test.at.expected" in
193193
EzFile.write_file f1 s1;
@@ -196,7 +196,7 @@ let log_failed_tests state msg tests =
196196
Promote.print_actions
197197
~not_exit:false
198198
~keep_old:false
199-
b2 t.test_actions ;
199+
t b2 t.test_actions ;
200200
let s2 = Buffer.contents b2 in
201201
let f2 = test_dir // "test.at.promoted" in
202202
EzFile.write_file f2 s2;

‎src/autofonce_lib/main.ml‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,6 @@ let commands = [
4343
Command_config.cmd ;
4444
Command_run.cmd ;
4545
Command_new.cmd ;
46-
Command_gen.cmd ;
4746
Command_regen.cmd ;
4847
Command_promote.cmd ;
4948
]

0 commit comments

Comments
 (0)